Question

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

我已在VBA Excel中编写此代码，以便将数据备份到excel中。代码不喜欢我为每个循环编写范围的方式。我也为每个循环尝试了第二个，但是它只是重复备份了主页面（尽管有正确的表名）。

我认为第一种方式很接近，但我不明白FullRange系列的类型是什么问题。

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

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

我拿出了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

Answer 1

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

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

Answer 2

这是一些工作代码，范围必须有！因为某些原因。

  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

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

2 个答案: