excel - Excel VBA - 应用程序定义或对象定义错误

问题描述

我是 VBA 脚本的新手。我开发了一个代码来将数据导出到具有预定义结构的 XML 文件。当我运行它时，我收到一个错误应用程序定义或对象定义错误。我不确定如何调试它，因为系统没有突出显示问题。您能帮我找出问题并进行必要的更改吗？

谢谢

Option Explicit
'Private Const ColDocDate As String = "DocDate"
'Private Const ColDocNum As String = "DocNum"
'Private Const ColCorrSyntAcc As String = "CorrSyntAcc"
'Private Const ColPayerSettAcc As String = "PayerSettAcc"
'Private Const ColReceiverName As String = "ReceiverName"
'Private Const ColReceiverSettlementAccount As String = "ReceiverSettlementAccount"
'Private Const ColCurrencyCode As String = "CurrencyCode"
'Private Const ColAmount As String = "Amount"
'Private Const ColPartnerCode As String = "PartnerCode"
'Private Const ColPaymentAim As String = "PaymentAim"
'Private Const ColTransactionDate As String = "TransactionDate"
Private Const ColDocDate As String = "A"
Private Const ColDocNum As String = "B"
Private Const ColCorrSyntAcc As String = "I"
Private Const ColPayerSettAcc As String = "D"
Private Const ColReceiverName As String = "G"
Private Const ColReceiverSettlementAccount As String = "H"
Private Const ColCurrencyCode As String = "E"
Private Const ColAmount As String = "J"
Private Const ColPartnerCode As String = "F"
Private Const ColPaymentAim As String = "K"
Private Const ColTransactionDate As String = "C"

Sub ExportToXML()
Dim oPaymOrders     As DOMDocument
Dim FName           As String
Dim sError          As String
On Error GoTo Err
 'create oPaymOrders
    Set oPaymOrders = New DOMDocument
        
    Call GenerateXML(oPaymOrders)
    FName = "PaymentOrders.xml"
        
ShowDlgSaveAS:
    FName = Application.GetSaveAsFilename(FName, _
                "XML Files (*.xml),*.xml", 1, "Save As")
    
    If Dir(FName) <> "" Then
        If MsgBox(prompt:=Dir(FName) & " already exists." & vbCrLf _
                        & "Do you want to replace it?", Buttons:=vbYesNo) = vbNo Then
            GoTo ShowDlgSaveAS
        End IF
    End If    
    If FName = "False" Then
        Exit Sub
    End If

    Call XMLToFile(oPaymOrders, FName)
    Exit Sub

Err:
    sError = Err.Description
 
    MsgBox sError, vbCritical
End Sub

Public Sub XMLToFile(ByVal xmlDoc As Object, ByVal FileName As String)
Dim wrt As New MXXMLWriter
Dim rdr As New SAXXMLReader
Dim fso As New FileSystemObject
Dim stream As TextStream
Dim sXml As String
Dim btXMLInBytes() As Byte
Dim lFile As Long
Dim fFile As File

    Set rdr.contentHandler = wrt
    Set rdr.dtdHandler = wrt
    Set rdr.errorHandler = wrt
    wrt.indent = True
    wrt.omitXMLDeclaration = False
    wrt.Version = "1.0"
    rdr.Parse xmlDoc
    
    sXml = wrt.output
    sXml = Replace(sXml, "encoding=""UTF-16""", "encoding=""UTF-8""")
    btXMLInBytes = UniStrToUTF8(sXml)
    
    If fso.FileExists(FileName) Then '
        Set fFile = fso.GetFile(FileName)
        fFile.Delete True
    End If
    
    lFile = FreeFile()
    Open FileName For Binary Access Write As lFile
    Put lFile, , btXMLInBytes
    Close lFile
End Sub


Public Sub GenerateXML(oPaymOrders As DOMDocument)
Dim FirstRow            As Long
Dim Count               As Long
Dim i                   As Long
Dim ErrCount            As Long
Dim oPaymOrder          As IXMLDOMElement
Dim oExchange           As IXMLDOMElement
Dim oElement            As IXMLDOMElement
Dim oManualEntriesList  As IXMLDOMElement
Dim DocTotalSumm        As Currency

    
    With Sheets("PayOrderGroupImport")
        FirstRow = .Range("DocDate").Row + 1
        
        'Exchange
        Set oExchange = oPaymOrders.createElement("Exchange")
        oExchange.setAttribute "xmlns", "http://wwww"
        oPaymOrders.appendChild oExchange
        
        Do While Trim$(.Range(ColDocDate & CStr(FirstRow))) <> ""
            Count = CountOfEntries(FirstRow)
            If Count > 0 Then
                'oPaymOrders
                Set oPaymOrder = oPaymOrders.createElement("PayOrd")
                oPaymOrder.setAttribute "xmlns:i", "http://www.w3.org/2001/XMLSchema-instance"
                oExchange.appendChild oPaymOrder
                
                'IsDraft
                Set oElement = oPaymOrders.createElement("IsDraft")
                oElement.nodeTypedValue = "false"
                oPaymOrder.appendChild oElement
            
                'DocHasSystemEntries
                Set oElement = oPaymOrders.createElement("DocHasSystemEntries")
                oElement.nodeTypedValue = "false"
                oPaymOrder.appendChild oElement
                
                'ManualEntriesList
                Set oManualEntriesList = oPaymOrders.createElement("ManualEntriesList")
                'oPaymOrder.appendChild oManualEntriesList
                
                'DocumentDate
                Set oElement = oPaymOrders.createElement("DocumentDate")
                oElement.nodeTypedValue = Format(.Range(ColDocDate & CStr(i - 1)), "yyyy-mm-ddT00:00:00")
                oPaymOrder.appendChild oElement
                
                'DocumentNumber
                Set oElement = oPaymOrders.createElement("DocumentNumber")
                oElement.nodeTypedValue = (Trim$(.Range(ColDocNum & CStr(i - 1))))
                oPaymOrder.appendChild oElement

                'CorrSyntAcc
                Set oElement = oPaymOrders.createElement("CorrSyntAcc")
                oElement.nodeTypedValue = (Trim$(.Range(ColCorrSyntAcc & CStr(i - 1))))
                oPaymOrder.appendChild oElement
                
                'PayerName
                Set oElement = oPaymOrders.createElement("PayerName")
                oElement.nodeTypedValue = "X"
                oPaymOrder.appendChild oElement
                
                'PayerSettlementAccount
                Set oElement = oPaymOrders.createElement("PayerSettlementAccount")
                oElement.nodeTypedValue = (Trim$(.Range(ColPayerSettAcc & CStr(i - 1))))
                oPaymOrder.appendChild oElement

                'PayerTaxCode
                Set oElement = oPaymOrders.createElement("PayerTaxCode")
                oElement.nodeTypedValue = "X"
                oPaymOrder.appendChild oElement

                'ReceiverName
                Set oElement = oPaymOrders.createElement("ReceiverName")
                oElement.nodeTypedValue = (Trim$(.Range(ColReceiverName & CStr(i - 1))))
                oPaymOrder.appendChild oElement

                'ReceiverSettlementAccount
                Set oElement = oPaymOrders.createElement("ReceiverSettlementAccount")
                oElement.nodeTypedValue = (Trim$(.Range(ColReceiverSettlementAccount & CStr(i - 1))))
                oPaymOrder.appendChild oElement
                
                'ReceiverTaxCode
                Set oElement = oPaymOrders.createElement("ReceiverTaxCode")
                oElement.nodeTypedValue = "X"
                oPaymOrder.appendChild oElement
                
                'CurrencyCode
                Set oElement = oPaymOrders.createElement("CurrencyCode")
                oElement.nodeTypedValue = (Trim$(.Range(ColCurrencyCode & CStr(i - 1))))
                oPaymOrder.appendChild oElement
                
                'Amount
                Set oElement = oPaymOrders.createElement("Amount")
                oElement.nodeTypedValue = (Trim$(.Range(ColAmount & CStr(i - 1))))
                oPaymOrder.appendChild oElement

                'PartnerCode
                Set oElement = oPaymOrders.createElement("PartnerCode")
                oElement.nodeTypedValue = (Trim$(.Range(ColPartnerCode & CStr(i - 1))))
                oPaymOrder.appendChild oElement
                
                'PaymentAim
                Set oElement = oPaymOrders.createElement("PaymentAim")
                oElement.nodeTypedValue = (Trim$(.Range(ColPaymentAim & CStr(i - 1))))
                oPaymOrder.appendChild oElement

                'TransactionDate
                Set oElement = oPaymOrders.createElement("TransactionDate")
                oElement.nodeTypedValue = Format(.Range(ColTransactionDate & CStr(i - 1)), "yyyy-mm-ddT00:00:00")
                oPaymOrder.appendChild oElement
            End If
            DocTotalSumm = 0
            FirstRow = FirstRow + Count
        Loop
    
    End With
End Sub
Function CountOfEntries(ByVal FirstRow As Long) As Long
Dim NextRow As Long

    NextRow = FirstRow + 1
    
    With Sheets("PayOrderGroupImport")
        Do While True
            If Trim$(.Cells(FirstRow, ColDocDate).Value) = Trim$(.Cells(NextRow, ColDocDate).Value) And _
               Trim$(.Cells(FirstRow, ColDocNum).Value) = Trim$(.Cells(NextRow, ColDocNum).Value) Then
                NextRow = NextRow + 1
            Else
                CountOfEntries = NextRow - FirstRow
                Exit Function
            End If
        Loop
    End With
End Function

标签： excelxmlvba

解决方案

如果你的介绍，说你是 VBA 的新手，从表面上看，你的成就真的很了不起。让我向您介绍 Enums（枚举）。这是代码中声明的常量块的替换。

Enum Col                        ' column IDs
    ColDocDate = 1
    ColDocNum
    ColTransactionDate
    ColPayerSettAcc
    ColCurrencyCode
    ColPartnerCode
    ColReceiverName
    ColReceiverSettlementAccount
    ColCorrSyntAcc
    ColAmount
    ColPaymentAim
End Enum

枚举是 VBA 将名称分配给整数的最有效方式。但是，您需要了解一些在这里工作的系统。第一个是您可以为任何名称分配任何数字，但如果您不分配任何值，则给出的值是前面的枚举加 1。因此，由于您看到1分配给第一个枚举而没有分配给下面的枚举，它们只是数着。1 = A 列，最后一个 11 = K 列。如果您要在ColPartnerCode处插入一列，您可以在此处分配一个不同的编号或插入一个额外的名称。它比常量灵活得多。

枚举必须在任何过程之前在模块顶部声明。默认情况下它们是公共的，但您可以将其声明为私有以将其范围限制为当前模块。枚举本质上是 Long 数据类型，并且可以与 Long 数据类型的数量互换。但是，如果您声明Dim MyLong As Col，您将获得智能感知的帮助。

枚举的全名由“family”名称和枚举名称组成，例如Col.ColDocDate（Col作为“family”）。这种命名方法让人想起 VBA 命名枚举的方式。它们都以 xl、vb、wd 或 mso 开头，但它们不是“姓氏”，而是标识符。xlRight是一个枚举，您可以在 (Excel) 代码中的任何位置使用它，而无需知道“家族”名称。对于ColDocDate. 范围由声明确定，私有或公共 [默认]。

因此，如果你用我的枚举替换你的常量，你将不得不面对的唯一问题是从字符串到长的转换。在代码Cells(R, ColDocDate)中，转换是由 Excel 完成的。但坦率地说，如果你有类似的语法Range(ColDocDate & R)，那么最好建议你为下一个项目保留这些知识。

excel - Excel VBA - 应用程序定义或对象定义错误

问题描述

解决方案

推荐阅读