如何通过 Access VBA 正确访问 Excel 文件

Question

我是一个非常新手的编码员，正在编写一个程序来从 Access table 中提取一些数据并将其放入 Excel Sheet。 Excel 工作簿创建正确，但是当我去保存它时，我得到一个

VBA Run-time error '1004' - Cannot access 'Checks and Transfers Import File 02122021.xlsx'.

当我尝试打开文件时，我收到一条消息，指出有人正在使用该文件，但我可以将其打开为“只读”。问题是没有其他人在使用该文件。我做错了什么？

'Transfers the checks/transfers from the two tables to an Excel sheet
Dim objXLApp As excel.Application
Dim objXLBook As excel.Workbook
Dim wS As excel.Worksheet
Dim rowCount As Integer
Dim rstChecks As New ADODB.Recordset
Dim rstTransfer As New ADODB.Recordset
    
Dim qdF As DAO.QueryDef
Dim rsT As DAO.Recordset

Dim qdF1 As DAO.QueryDef
Dim rsT1 As DAO.Recordset

Set qdF = CurrentDb.QueryDefs("tbl_BankImportChecks Query") ' Gets all fields from Table1
Set qdF1 = CurrentDb.QueryDefs("tbl_BankImportTransfers Query") ' Gets 401(k) contribution and match information

Set rsT = qdF.OpenRecordset
Set rsT1 = qdF1.OpenRecordset

rsT.MoveLast
rsT.MoveFirst
rsT1.MoveLast
rsT1.MoveFirst

Set objXLApp = CreateObject("Excel.Application")
objXLApp.Workbooks.Add
objXLApp.Visible = True

Set wS = objXLApp.Worksheets("Sheet1")

wS.NaMe = "Checks" & Format(Me.DTPicker8.Value, "mmdd")
objXLApp.Sheets("Checks" & Format(Me.DTPicker8.Value, "mmdd")).Activate

wS.Range("A1").Value = "Bank Account"
wS.Range("B1").Value = "Payee"
wS.Range("C1").Value = "Check Date"
wS.Range("D1").Value = "Check Number"
wS.Range("E1").Value = "Check Memo"
wS.Range("F1").Value = "Address Line 1"
wS.Range("G1").Value = "Address Line 2"
wS.Range("H1").Value = "Address City"
wS.Range("I1").Value = "Address State"
wS.Range("J1").Value = "Address Zip"
wS.Range("K1").Value = "Expenses Account"
wS.Range("L1").Value = "Expenses Amount"
wS.Range("M1").Value = "Expenses Memo"
wS.Range("N1").Value = "Expenses Customer Job"
wS.Range("O1").Value = "Not Used"
wS.Range("P1").Value = "Temp Type"
wS.Range("Q1").Value = "Paycheck Amount"
wS.Range("R1").Value = "State"

rowCount = 2

Do While Not rsT.EOF
    wS.Range("A" & rowCount).Value = rsT.Fields(4).Value 'Bank Account (11100)
    wS.Range("B" & rowCount).Value = rsT.Fields(0).Value 'Vendor
    wS.Range("C" & rowCount).Value = rsT.Fields(2).Value 'Check Date
    wS.Range("D" & rowCount).Value = "EFT"
    wS.Range("E" & rowCount).Value = rsT.Fields(3).Value ' Check Memo
    wS.Range("K" & rowCount).Value = rsT.Fields(5).Value 'Expense Account
    wS.Range("L" & rowCount).Value = Abs(Val(rsT.Fields(1).Value)) 'Check Amount
    rowCount = rowCount + 1
    rsT.MoveNext
Loop

Set wS = objXLApp.Worksheets.Add
Set wS = objXLApp.Worksheets("Sheet2")
wS.NaMe = "Transfers" & Format(Me.DTPicker8.Value, "mmdd")
objXLApp.Sheets("Transfers" & Format(Me.DTPicker8.Value, "mmdd")).Activate

wS.Range("A1").Value = "To Account"
wS.Range("B1").Value = "From Account"
wS.Range("C1").Value = "Transfer Date"
wS.Range("D1").Value = "Transfer Memo"
wS.Range("E1").Value = "Transfer Amount"

rowCount = 2
Do While Not rsT1.EOF
    wS.Range("A" & rowCount).Value = rsT1.Fields(0).Value 'To Account
    wS.Range("B" & rowCount).Value = rsT1.Fields(1).Value 'From Account
    wS.Range("C" & rowCount).Value = rsT1.Fields(2).Value 'Transfer Date
    wS.Range("D" & rowCount).Value = Abs(Val(rsT1.Fields(3).Value)) 'Amount
    wS.Range("E" & rowCount).Value = rsT1.Fields(4).Value 'Transfer Memo
    rowCount = rowCount + 1
    rsT1.MoveNext
Loop
objXLApp.ActiveWorkbook.SaveAs "C:\Users\Jim's Surface Pro 5\Dropbox\Working Folder\Jim dePrado\Quickbooks Access Files\" & "Checks and Transfers Import File " & Format(Now(), "mmddyyyy")
objXLApp.ActiveWorkbook.Close

Set qdF = Nothing
Set qdF1 = Nothing
Set rsT = Nothing
Set rsT1 = Nothing
Set objXLApp = Nothing
Set objXLBook = Nothing
Set wS = Nothing

MsgBox "done"

Answer 1

因此，您可能需要：

Set objXLApp = CreateObject("Excel.Application")
Set objXLBook = objXLApp.Workbooks.Add

Set wS = objXLBook.Worksheets(1) ' Sheet name is localised.
wS.Name = "Checks" & Format(Me.DTPicker8.Value, "mmdd")
' Should not be needed.
' objXLApp.Sheets("Checks" & Format(Me.DTPicker8.Value, "mmdd")).Activate

' ---

objXLBook.SaveAs "C:\Users\Jim's Surface Pro 5\Dropbox\Working Folder\Jim dePrado\Quickbooks Access Files\" & "Checks and Transfers Import File " & Format(Now(), "mmddyyyy")

Set wS = Nothing
Set objXLBook = Nothing

objXLApp.Quit
Set objXLApp = Nothing

如何通过 Access VBA 正确访问 Excel 文件

How do I properly access Excel Files through Access VBA

excel

vba

file-access