2

Very new to VBA and trying to create an automated textfile export. Currently it works like a charm for row 1 and the textfile is created. But when adding data on row 2 as well I get:

Runtime error 91, Object variable or With block variable not set.

Any help would be much appreciated!

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
AAA
  • 3,520
  • 1
  • 15
  • 31
roobeat
  • 21
  • 1

1 Answers1

1

Your problem is not exactly what you'd be expecting.

Note that in your while loop, you close your filestream object at the end with fsoTextStream2.Close. What you'll be seeing is that it will successfully write the first line, but then close the file and then try to write to a file that is closed.

Simply moving this outside the loop (after wend) will fix your problem (Shown below).

                    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

There's quite a few improvements for your code, if you alter it slightly to avoid .select calls. Also .value rather than .text might be useful if your cells have numeric input. Note that you can extract cell values without having them selected by using range("A" & i).value (or simply range("A" & i)) using worksheet("sheetname").range("A" & i) to access specific sheet cells. (cells(row, column) works just as well).

Oliver
  • 8,169
  • 3
  • 15
  • 37