Excel VBA - 應用程序定義或對象定義錯誤

Question

我是 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

Answer 1

如果你的介紹，說你是 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 中插入一列，您可以在那里分配一個不同的數字或插入一個額外的名稱。 它比常量靈活得多。

枚舉必須在任何過程之前在模塊的頂部聲明。 默認情況下它們是Public ，但您可以將其聲明為Private以將其范圍限制為當前模塊。 枚舉本質上是 Long 數據類型，可與 Long 數據類型的數字互換。 但是，如果您將Dim MyLong As Col聲明Dim MyLong As Col您將獲得Dim MyLong As Col幫助。

枚舉的全名由“家族”名稱和枚舉名稱組成，例如Col.ColDocDate （ Col是“家族”）。 這種命名方法讓人想起 VBA 如何命名枚舉。 它們都以 xl、vb、wd 或 mso 開頭，但它們不是“姓氏”，而是標識符。 xlRight是一個枚舉，您可以在 (Excel) 代碼中的任何位置使用它，而無需知道“家族”名稱。 ColDocDate 。 范圍由聲明決定，可以是私有的，也可以是公共的 [默認]。

因此，如果你用我的枚舉替換你的常量，你將面臨的唯一問題是從字符串到長的轉換。 在像Cells(R, ColDocDate)這樣的代碼中Cells(R, ColDocDate)轉換是由 Excel 完成的。 但是，坦率地說，如果您有Range(ColDocDate & R)類的語法，那么您可能最好將這些知識保留在您的下一個項目中。