在 DoCmd.TransferSpreadSheet（Excel 中的 VBA Access）中正确设置范围？

Setting range properly in DoCmd.TransferSpreadSheet (VBA Access in Excel)?

提问by user2457541

For Each Page In Worksheets
    PageName = Split(Page.Name, " ")
    If UBound(PageName) > 0 Then
        Worksheets(Page.Name).Activate
        lRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
        LCol = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
        Fullrange = Worksheets(Page.Name).Range(Worksheets(Page.Name).Cells(1, 1), _
            Worksheets(Page.Name).Cells(lRow, LCol))
        accappl.DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, _
            Page.Name, strpathxls, True, Fullrange
    End If
Next

I have written this code in VBA Excel to backup data into access from excel. The code doesn't like the way that I wrote the range in my for each loops. I also tried the 2nd for each loop, but that just backed up the main page repeatedly( with the correct table names though).

我已经在 VBA Excel 中编写了这段代码，以将数据备份到 excel 的访问中。代码不喜欢我在 for each 循环中编写范围的方式。我还为每个循环尝试了第二个，但这只是反复备份主页（尽管使用了正确的表名）。

I think the 1st way is close, but I don't understand what is wrong with FullRange line which is type Range.

我认为第一种方法很接近，但我不明白类型 Range 的 FullRange 线有什么问题。

EDIT: The error is object variable or with block variable not set on the FullRange line

编辑：错误是对象变量或块变量未在 FullRange 行上设置

Update 6-18, It seems that the fullrange should be in the form string. I have edited a little but the error I am getting now on the transferspreadsheet line is "The Microsoft database engine could not find the object'1301 Array$A$1:J$12'. Make sure that the object exists and you spell its name correctly.

更新 6-18，似乎 fullrange 应该在表单字符串中。我已经编辑了一点，但我现在在 transferspreadsheet 行上遇到的错误是“Microsoft 数据库引擎找不到对象'1301 Array$A$1:J$12'。确保该对象存在并且您正确拼写了它的名称.

I took out fullrange and put in page.name and it gave me the same error.

我取出 fullrange 并放入 page.name ，它给了我同样的错误。

For Each Page In Worksheets
    PageName = Split(Page.Name, " ")
    If UBound(PageName) > 0 Then
        ' Worksheets(Page.Name).Activate - this line is most likely not needed
        lRow = Page.Range("A" & Rows.Count).End(xlUp).Row
        LCol = Page.Cells(2, Columns.Count).End(xlToLeft).Column
        fullRange = Page.Name & Page.Range(Page.Cells(1, 1), _
            Page.Cells(lRow, LCol)).Address
        accappl.DoCmd.TransferSpreadsheet acImport, _
            acSpreadsheetTypeExcel12Xml, Page.Name, strpathxls, True, Page.Name
    End If
Next  

采纳答案by user2457541

I have modified your code a bit, have a look see if you can see where youve gone wrong.

我稍微修改了你的代码，看看你是否能看到你哪里出错了。

Dim Page As Worksheet
Dim lRow As Long, LCol As Long
Dim fullRange As Range
Dim PageName As Variant

For Each Page In Worksheets

    PageName = Split(Page.Name, " ")

    If UBound(PageName) > 0 Then
        ' Worksheets(Page.Name).Activate - this line is most likely not needed
        lRow = Page.Range("A" & Rows.Count).End(xlUp).Row
        LCol = Page.Cells(1, Columns.Count).End(xlToLeft).Column
        Set fullRange = Page.Range(Cells(1, 1), Cells(lRow, LCol))
        accappl.DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, Page.Name, strpathxls, True, fullRange
    End If
Next

回答by user2457541

Here is some working code, the range has to have a ! in it for some reason.

这是一些工作代码，范围必须有一个！出于某种原因在其中。

  Sub BU_ACCESS()

Dim accappl As Access.Application
Dim strpathdb As String
Dim strpathxls As String
'Dim myrange As String, myrow1 As String, myrow2 As String
'Dim fullRange As Range



strpathdb = "C:\Users\tgfesaha\Desktop\Database1.accdb"
'path to the upload file

strpathxls = ActiveWorkbook.FullName




Set accappl = New Access.Application

accappl.OpenCurrentDatabase strpathdb
Dim Page As Worksheet
Dim lRow As Long, LCol As Long
Dim fullrange As String
Dim PageName As Variant
'fullRange = Worksheets(Page.Name).Range(Worksheets(Page.Name).Cells(1, 1), Worksheets(Page.Name).Cells(lRow, LCol))

For Each Page In Worksheets

    PageName = Split(Page.Name, " ")

    If UBound(PageName) > 0 Then
        ' Worksheets(Page.Name).Activate - this line is most likely not needed
        lRow = Page.Range("A" & Rows.Count).End(xlUp).Row
        LCol = Page.Cells(2, Columns.Count).End(xlToLeft).Column
        fullrange = Page.Range(Page.Cells(1, 1), Page.Cells(lRow, LCol)).Address
        xclam = Page.Name & "!" & fullranges

        accappl.DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, Page.Name, strpathxls, True, xclam
    End If
Next

accappl.Quit

End Sub