Question

我正在尝试在Excel 2007中创建一个宏，这样当我在Sheet2（运行按钮所在的位置）时 - 宏从Access读取指定的表并将数据复制到下一个工作表（sheet3）。然后Sheet3仅保存到CSV文件，宏将我返回到Sheet2并从xlsm文件中删除Sheet3数据 - 如果可能，这些步骤在后台完成，而不是运行宏的人看到。我尝试过类似帖子的其他提示无济于事。我正在尝试定制一个录制的宏 - 但它将xlsm保存为csv文件并关闭xlsm。宏（PleaseWork.xlsm）保存在我的文档中，我希望将working.csv保存在我的桌面上。请尽可能提供帮助。

With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array(Array( _
    "ODBC;DSN=MS Access Database;DBQ=CorrectPath\access_dbs\Copy of fldsdb.mdb;Default" _
    ), Array( _
    "Dir=CorrectPath\access_dbs;DriverId=25;FIL=MS Access;MaxBufferSize=2048;Page" _
    ), Array("Timeout=5;")), Destination:=Range("$A$1")).QueryTable
    .CommandText = Array( _
    "SELECT table.table_identifier" & Chr(13) & "" & Chr(10) & "FROM table.table" _
    )
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .PreserveColumnInfo = True
    .ListObject.DisplayName = "Table_Query_from_MS_Access_Database"
    .Refresh BackgroundQuery:=False
End With
Selection.Copy
Range("B1").Select
Columns("B:B").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=True, Transpose:=False
Columns("B:B").EntireColumn.AutoFit
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Range("A10").Select
ChDir "Desktop"
ActiveWorkbook.SaveAs Filename:= _
    "...\working.csv", FileFormat _
    :=xlCSV, CreateBackup:=False
Sheets("Sheet2").Select
End Sub

Answer 1

Sheets("Sheet3").Select
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array(Array( _
"ODBC;DSN=MS Access Database;DBQ=CorrectPath\access_dbs\Copy of fldsdb.mdb;Default" _
), Array( _
"Dir=CorrectPath\access_dbs;DriverId=25;FIL=MS Access;MaxBufferSize=2048;Page" _
), Array("Timeout=5;")), Destination:=Range("$A$1")).QueryTable
.CommandText = Array( _
"SELECT desired_table.desired_table_cd" & Chr(13) & "" & Chr(10) & "FROM desired_table desired_table" _
)
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "Table_Query_from_MS_Access_Database"
.Refresh BackgroundQuery:=False
End With
Application.Sheets("Sheet3").Select
Application.Sheets("Sheet3").Copy
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:="...\working", FileFormat:=xlCSV, _
CreateBackup:=False
ActiveWorkbook.Save
ActiveWindow.Close
Windows("PleaseWork.xlsm").Activate
Worksheets("Sheet3").Range("A1:G65336").ClearContents
Sheets("Sheet2").Select
End Sub

Excel宏：将1个工作表另存为CSV，同时保留xlsm

1 个答案: