0 
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 访问。代码不喜欢我在 for each 循环中编写范围的方式。我还为每个循环尝试了第二个，但这只是重复备份了主页（尽管使用了正确的表名）。

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

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

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

我拿出全量程并输入 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
4

2 回答 2

0

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
于 2013-06-18T07:17:46.273 回答
0

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

  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
于 2013-06-18T16:44:04.837 回答