【问题标题】:Unable to late bind excel from Access VBA - Workbooks.Open doesn't work无法从 Access VBA 后期绑定 Excel - Workbooks.Open 不起作用
【发布时间】:2020-07-03 07:16:20
【问题描述】:

按照 Fenton 先生的建议,我想开始删除我对后期绑定的引用。但是,我尝试晚绑定 Excel,就像我查找的所有内容一样,并且在添加之前无法修复它 “Microsoft Visual Basic for Applications 可扩展性 5.3”。

我目前的参考资料是:

Visual Basic for Applications
Microsoft Access 15.0 Object Library
Microsoft Data Access Components Installed Version
Microsoft ActiveX Data Objects 6.1 Library
Microsoft DAO 3.6 Object Library
Microsoft Windows Common Controls 6.0 (SP6)
Microsoft Scripting Runtime
Microsoft XML,v6.0
Microsoft Visual Basic for Applications Extensibility 5.3.

使用 Windows 10、Access 2013 Runtime 和 accdb 完成测试。

这里是带有声明的函数的顶部和带有错误的部分:

On Error GoTo errHandle:

Dim FileToImport As Variant
Dim FilesLoaded As String
Dim csvStr As String
DoCmd.Hourglass False
Dim Loc As Integer

Loc = Forms!StartPage.LocationID

Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim ofile As Object
Dim fdialog As Object
Dim rs As ADODB.Recordset
Dim uid As String
uid = Forms!AppLoginFrm!FullName
Dim stp As String
Dim thestr As String
Dim inboundrs As ADODB.Recordset
Dim ChkInbound As String
Dim repprg As Long
Dim ExcelApp As Object
Dim fname As String
Dim rng As Object
Dim wb As Object
Dim xlsheet1 As Object
Dim skiphead As Integer
stp = format(Now, "yyyy-mm-dd hh:nn:ss")
Dim tmpfile As String

tmpfile = TempPath()

tmpfile = tmpfile & "tmpLoad.txt"

skiphead = 2
Set fdialog = Application.FileDialog(3)
fdialog.Filters.Clear
fdialog.Filters.Add "Excel Files", "*.xls,*.xlsx"

    fdialog.AllowMultiSelect = True
    If fdialog.Show = 0 Then
    Exit Function
    End If


Set ofile = fso.CreateTextFile(tmpfile, True, False)


     ofile.WriteLine """Location""" & "," & """YardTrack""" & "," & """Dir""" & "," & """Seq"""...

        For Each FileToImport In fdialog.SelectedItems

    Set ExcelApp = CreateObject("Excel.Application")

    With ExcelApp
    .Workbooks.Open FileToImport

        .DisplayAlerts = -1
        .Visible = -1
        .Windows(1).Visible = -1

        Set xlsheet1 = .Worksheets(1)
        Set rng = xlsheet1.UsedRange

            If xlsheet1.cells(1, 1).Value = "TOT-CARS" Then
                skiphead = 3
            End If
        For i = skiphead To rng.rows.count
            csvStr = csvStr & Chr(34) & rng(i, 1) & Chr(34) & "," & Chr(34) & rng(i, 2) & Chr...

            ofile.Write csvStr
            csvStr = ""
            Next

              ofile.Write Chr(34) & csvStr & Chr(34) & vbCrLf
            ExcelApp.Workbooks.Close
            Set rng = Nothing
            Set xlsheet1 = Nothing
      End With
            FilesLoaded = FilesLoaded & vbCrLf & fileName(FileToImport)

        Next FileToImport


ExcelApp.Quit
ofile.Close
Set fdialog = Nothing

问题:

1) 我错过了 Open 的常量吗?关键是要删除引用,但要完成这项工作,我必须添加一个。 :(

2) 接下来我应该尝试删除哪些引用?老实说,在上一个之后我有点害怕,但我希望程序尽可能稳定。

提前谢谢你!

【问题讨论】:

  • 对于初学者 - 使用变量来引用您的工作簿。 Set xlsheet1 = .Worksheets(1) - 这应该是指工作簿父级,但当前指的是应用程序实例...
  • 您也不需要为每次迭代创建新的Excel Application。您可以保留应用程序对象并打开/关闭工作簿。将节省一些时间/内存。

标签: excel vba ms-access


【解决方案1】:

这是我从我的个人代码 stuffz 中复制/粘贴的内容。它是用于处理 excel 的通用后期绑定模板。你可以通过设置一个包含所有 excle 常量的模块来提高你的后期绑定效率。很漂亮的东西。

Option Compare Database
Public Function getFile() As String
    Dim f As Object
    Dim i As Long
    Set f = Application.FileDialog(3)
    f.AllowMultiSelect = False
    If f.Show Then
        If f.SelectedItems.Count > 0 Then
            getFile = f.SelectedItems(1)
        End If
    End If
End Function

Public Function ConvUNC(filePath As String) As String
    Dim fileR As String
    fileR = Replace(filePath, "C:", "C$")
    ConvUNC = "\\" & Environ$("computername") & "\" & fileR
End Function

Public Sub UploadExcel()
    On Error GoTo UpLoadExcel_Err
    Dim fileP As String, FileDir As String
    Dim oXL As Object, sheet As Object
    Dim bringOver As Variant

    fileP = getFile
    If fileP = "" Then GoTo CleanUp
    FileDir = Left(fileP, InStrRev(fileP, "\") - 1) & "\"

    Set oXL = CreateObject("Excel.Application")
    With oXL
        .WorkBooks.Open FileName:=FileDir & Dir$(fileP)
        Open NewTextFile For Output As #2
        For Each sheet In .Worksheets
            bringOver = .ActiveSheet.UsedRange
NextSheet:
            Erase bringOver
        Next sheet
    End With

CleanUp:
    On Error Resume Next
    DoEvents
    oXL.Quit
    oXL.Application.Quit
    Erase bringOver
    Exit Sub
UpLoadExcel_Err:
    MsgBox "An error has occured.  " & " " & Err.Number & " " & Err.Description & " "
    GoTo CleanUp
    Resume
End Sub

【讨论】:

    【解决方案2】:

    BigBen 似乎找到了答案。我刚换了工作簿。我还按照 Krish 的建议将 CreateObject 移出循环,因为它当然应该在循环之外! :)

    设置 wb = .Workbooks.Open(FileToImport)

    .DisplayAlerts = -1
    .Visible = -1
    .Windows(1).Visible = -1
    
    Set xlsheet1 = wb.Worksheets(1)
    Set rng = xlsheet1.UsedRange
    

    Doug,我认为你是对的,我应该创建一个可重用的函数。我还没有完成 ConvUNC .. 可能应该。我不能按原样使用您的代码,因为几个 excel 使用使用多项选择,但我想我可以 tweek 它。

    感谢大家的帮助。

    【讨论】:

      猜你喜欢
      • 1970-01-01
      • 2021-04-10
      • 2019-03-09
      • 2014-01-21
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 2018-10-20
      相关资源
      最近更新 更多