2

对 VBA 非常陌生，并尝试创建自动文本文件导出。目前，它就像第 1 行的魅力一样，并且创建了文本文件。但是当我在第 2 行添加数据时，我得到：

运行时错误 91，未设置对象变量或 With 块变量。

任何帮助将非常感激！

Sub Exportera()

    Dim bKlar           As Boolean
    Dim bSkrivPSlut     As Boolean
    Dim bSkrivPStart    As Boolean

    Dim fsoExpFil       As FileSystemObject
    Dim fsoTextStream2  As TextStream
    Dim sExportFile     As String
    Dim iSvar           As Integer
    Dim iSvar2          As Integer

    Dim sSokvag         As String
    Dim sFilnamn        As String

    Dim sTemp           As String
    Dim sPFalt          As String
    Dim cVarde          As Currency
    Dim sDatum          As String


    'alright då skapar vi fil och skriver till den
    Set fsoExpFil = New FileSystemObject

    Range("K10").Select
    sSokvag = Trim(ActiveCell.FormulaR1C1)

    Range("K13").Select
    sFilnamn = Trim(ActiveCell.FormulaR1C1)

    If Not UCase(Right(sFilnamn, 4)) = ".TXT" Then
        sFilnamn = sFilnamn & ".txt"
    End If

    sExportFile = sSokvag & "\" & sFilnamn

    If sSokvag = "" Or sFilnamn = "" Then
        MsgBox "Exporten avbryts då sökväg och filnamn saknas för exportfilen.", vbInformation, sAppName
        Exit Sub
    Else

        If fsoExpFil.FileExists(sExportFile) = True Then
            iSvar = MsgBox("Filen " & sFilnamn & " finns redan, skall den ersättas?", vbYesNo, sAppName)
            If iSvar = vbNo Then
                Exit Sub
            End If
        Else
            iSvar = MsgBox("Är du säker att du vill exportera?", vbYesNo, "Exportera")
        End If
    End If

    If iSvar = vbYes Then
        Set fsoTextStream2 = fsoExpFil.OpenTextFile(sExportFile, ForWriting, True)

        fsoTextStream2.WriteLine "Filhuvud"
        fsoTextStream2.WriteLine vbTab & "Typ=" & """Anställda"""
        sTemp = "SkapadAv=" & """"
        sTemp = sTemp & "Importfil"
        sTemp = sTemp & """"
        fsoTextStream2.WriteLine vbTab & sTemp
        fsoTextStream2.WriteLine vbTab & "DatumTid=" & "#" & Now & "#"


        bKlar = False

        i = 1
        Sheets("Data").Select
        While bKlar = False
            i = i + 1
            Range("A" & i).Select
            If Trim(ActiveCell.FormulaR1C1) <> "" Then
                If IsNumeric(ActiveCell.FormulaR1C1) Then
                    fsoTextStream2.WriteLine "PStart"
                    fsoTextStream2.WriteLine "    Typ = ""Anställda"""

                    Range("A" & i).Select
                    If Trim(ActiveCell.FormulaR1C1) <> "" Then
                        fsoTextStream2.WriteLine "    Anställningsnummer = " & ActiveCell.FormulaR1C1
                    End If


                    Range("B" & i).Select
                    If Trim(ActiveCell.Text) <> "" Then
                            fsoTextStream2.WriteLine "    Namn=" & Trim(ActiveCell.FormulaR1C1)
                    End If

                    Range("D" & i).Select
                    If Trim(ActiveCell.Text) <> "" Then
                            fsoTextStream2.WriteLine "    Utdelningsadress=" & ActiveCell.FormulaR1C1
                    End If

                    Range("E" & i).Select
                    If Trim(ActiveCell.Text) <> "" Then
                            fsoTextStream2.WriteLine "    co_adress=" & ActiveCell.FormulaR1C1
                    End If


                    Range("G" & i).Select
                    If Trim(ActiveCell.Text) <> "" Then
                            fsoTextStream2.WriteLine "    Postadress=" & ActiveCell.FormulaR1C1
                    End If


                    Range("F" & i).Select
                    If Trim(ActiveCell.Text) <> "" Then
                            fsoTextStream2.WriteLine "    Postnummer=" & ActiveCell.FormulaR1C1
                    End If


                    Range("C" & i).Select
                    If Trim(ActiveCell.Text) <> "" Then
                            sTemp = ActiveCell.FormulaR1C1
                            sTemp = Mid(sTemp, 1, 6) & "-" & Mid(sTemp, 7)
                            fsoTextStream2.WriteLine "    Personnummer=" & sTemp
                    End If

                    Range("H" & i).Select
                    If Trim(ActiveCell.Text) <> "" Then
                            fsoTextStream2.WriteLine "    E_mail=" & ActiveCell.FormulaR1C1
                    End If

                    Range("I" & i).Select
                    If Trim(ActiveCell.Text) <> "" Then
                            sTemp = ActiveCell.FormulaR1C1

                            Range("AM" & i).Select
                            sTemp = sTemp & ActiveCell.FormulaR1C1
                            sTemp = Replace(sTemp, "-", "")
                            fsoTextStream2.WriteLine "    Bankkontonummer=" & sTemp

                    End If

                            Range("J" & i).Select
                    If Trim(ActiveCell.Text) <> "" Then
                            sDatum = ActiveCell.Text
                            fsoTextStream2.WriteLine "    Anställningsdatum=" & "#" & sDatum & "#"
                    End If


                    fsoTextStream2.WriteLine "PSlut"
                    fsoTextStream2.Close
                    MsgBox "Exporten är klar", vbInformation, sAppName
                End If

            Else
                bKlar = True

            End If

        Wend

    End If
End Sub
4

1 回答 1

1

你的问题并不完全是你所期望的。

请注意，在您的 while 循环中，您filestream object最后用fsoTextStream2.Close. 您将看到它会成功写入第一行，然后关闭文件，然后尝试写入已关闭的文件。

只需将其移出循环（之后wend）即可解决您的问题（如下所示）。

                    fsoTextStream2.WriteLine "PSlut"
                    MsgBox "Exporten är klar", vbInformation, sAppName
                End If
            Else
                bKlar = True
            End If
        Wend
        fsoTextStream2.Close 'This line has been moved outside the loop         
    End If
End Sub

如果您稍微更改它以避免.select调用，您的代码会有很多改进。如果您的单元格有数字输入，也不是很有.value用。.text请注意，您可以提取单元格值而无需通过使用range("A" & i).value（或简单地range("A" & i)）使用来选择它们worksheet("sheetname").range("A" & i)来访问特定的工作表单元格。（cells(row, column)同样有效）。

于 2019-07-13T16:28:15.500 回答