解决Excel VBA文本文件导出中的运行时91错误

时间:2019-07-13 15:30:33

标签: excel vba runtime-error text-files export-to-text

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

1 个答案:

答案 0 :(得分: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)也一样)。