Exporteren naar een txt bestand

[gast0199]

Met de huidige code exporteer ik gegevens van een excel sheet naar een txt bestand. Echter als ik gebruik van deze functie maak, wordt alleen de gegevens van de 1e kolom geëxporteerd. Ipv. alleen de eerste kolom, moeten de eerste 4 kolommen worden geëxporteerd.

-----------------------------------------------------------------------------------
Code:

Private Sub CommandButton1_Click()

Dim intTeller As Integer
Dim strEersteLijn As String
Dim strTweedeLijn As String


Open ActiveWorkbook.Path & "/" & InputBox("Uitvoeren naar: ", "Bestandsnaam", "bestellijst.txt") For Output As #1
Print #1, "Bestellijst" & vbCrLf & vbCrLf

intTeller = 1

While Cells(intTeller, 1).Value <> ""
strEersteLijn = Cells(intTeller, 1)
intTeller = intTeller + 1
Print #1, strEersteLijn


Wend
Close #1

antwoord = MsgBox("Verkenner openen om bestand te bekijken?", vbYesNo, "Uitvoer gelukt")

If antwoord = vbYes Then
On Error Resume Next
Set oshell = CreateObject("wscript.shell")
strPath = ThisWorkbook.Path
If Err.Number <> 0 Then
MsgBox "Niet gelukt", , "Explorer niet beschikbaar"
On Error GoTo 0
Else
Shell "explorer.exe " & strPath, vbNormalFocus
End If
End If

End Sub
-----------------------------------------------------------------------------------

Wie kan mij helpen met deze (kleine) aanpassingen?

Alvast bedankt !

 

[Roncancio]

Private Sub CommandButton1_Click()

Dim intTeller As Integer
Dim strEersteLijn As String
Dim strTweedeLijn As String
Dim intKolom As Integer

Open ActiveWorkbook.Path & "/" & InputBox("Uitvoeren naar: ", "Bestandsnaam", "bestellijst.txt") For Output As #[B][COLOR="red"]1[/COLOR][/B]
Print #1, "Bestellijst" & vbCrLf & vbCrLf

intTeller = 1
For intKolom = 1 To 4
While Cells(intTeller, intKolom).Value <> ""
strEersteLijn = Cells(intTeller, intKolom)
intTeller = intTeller + 1
Print #1, strEersteLijn
Next

Wend
Close #1

antwoord = MsgBox("Verkenner openen om bestand te bekijken?", vbYesNo, "Uitvoer gelukt")

If antwoord = vbYes Then
On Error Resume Next
Set oshell = CreateObject("wscript.shell")
strPath = ThisWorkbook.Path
If Err.Number <> 0 Then
MsgBox "Niet gelukt", , "Explorer niet beschikbaar"
On Error GoTo 0
Else
Shell "explorer.exe " & strPath, vbNormalFocus
End If
End If

End Sub

Ik raad af om bij Open For Output een vaste waarde te gebruiken. (rode getal).
Veiliger is om VBA zelf een waarde te laten zoeken.

Met vriendelijke groet,


Roncancio

 

[gast0199]

Dank voor je snelle reactie !

Helaas is mijn VBA-kunde niet zozeer groot, dat ik dit zo aan kan passen.
Hopelijk is er iemand bereidt om mij op weg te helpen?

Met vriendelijk groet,

Bastiaan

 

[Roncancio]

Private Sub CommandButton1_Click()

Dim intTeller As Integer
Dim strEersteLijn As String
Dim strTweedeLijn As String
Dim intKolom As Integer
Dim intBestandsNummer As Integer

intBestandsNummer = FreeFile
Open ActiveWorkbook.Path & "/" & InputBox("Uitvoeren naar: ", "Bestandsnaam", "bestellijst.txt") For Output As # BestandsNummer
Print #1, "Bestellijst" & vbCrLf & vbCrLf

intTeller = 1
For intKolom = 1 To 4
While Cells(intTeller, intKolom).Value <> ""
strEersteLijn = Cells(intTeller, intKolom)
intTeller = intTeller + 1
Print #1, strEersteLijn
Next

Wend
Close #1

antwoord = MsgBox("Verkenner openen om bestand te bekijken?", vbYesNo, "Uitvoer gelukt")

If antwoord = vbYes Then
On Error Resume Next
Set oshell = CreateObject("wscript.shell")
strPath = ThisWorkbook.Path
If Err.Number <> 0 Then
MsgBox "Niet gelukt", , "Explorer niet beschikbaar"
On Error GoTo 0
Else
Shell "explorer.exe " & strPath, vbNormalFocus
End If
End If

End Sub

Met FreeFile zoekt VBA zelf.

Met vriendelijke groet,


Roncancio

 

[gast0199]

Ligt het aan mij of werkt de bovenstaande code niet correct?

Ten eerste krijg ik een Compileerfout: Next zonder For.
Daarnaast krijg ik fout 52 tijdens uitvoering.

Wat is er mis?

Met vriendelijke groeten,

Bastiaan

 

[Roncancio]

En zo?

Private Sub CommandButton1_Click()

Dim intTeller As Integer
Dim strEersteLijn As String
Dim strTweedeLijn As String
Dim intKolom As Integer
Dim intBestandsNummer As Integer

    intBestandsNummer = FreeFile
    Open ActiveWorkbook.Path & "/" & InputBox("Uitvoeren naar: ", "Bestandsnaam", "bestellijst.txt") For Output As #BestandsNummer
    Print #1, "Bestellijst" & vbCrLf & vbCrLf
    
    intTeller = 1
    For intKolom = 1 To 4
        While Cells(intTeller, intKolom).Value <> ""
            strEersteLijn = Cells(intTeller, intKolom)
            intTeller = intTeller + 1
            Print #1, strEersteLijn
        Wend
    Next
    Close #1
    
    antwoord = MsgBox("Verkenner openen om bestand te bekijken?", vbYesNo, "Uitvoer gelukt")
    
    If antwoord = vbYes Then
        On Error Resume Next
        Set oshell = CreateObject("wscript.shell")
        strPath = ThisWorkbook.Path
        If Err.Number <> 0 Then
            MsgBox "Niet gelukt", , "Explorer niet beschikbaar"
            On Error GoTo 0
        Else
            Shell "explorer.exe " & strPath, vbNormalFocus
        End If
    End If

End Sub

Met vriendelijke groet,


Roncancio

 

[gast0199]

Laat ik voorop stellen dat ik jou hulp zeer waardeer !

De fouten zijn eruit, echter is er geen verschil te zien in het txt bestand.
Dus zie nog steeds de eerste kolom van het exelsheet?

Bastiaan

 

[Warme bakkertje]

Private Sub CommandButton1_Click()

Dim i As Integer, strEersteLijn As String
Dim intKolom As Integer, intBestandsNummer As Integer

intBestandsNummer = FreeFile
FName = ActiveWorkbook.Path & "\" & InputBox("Uitvoeren naar: ", "Bestandsnaam", "bestellijst.txt")
Open FName For Output As #intBestandsNummer
Print #1, "Bestellijst" & vbCrLf & vbCrLf

For i = 2 To ActiveSheet.UsedRange.Rows.Count
    strEersteLijn = ""
    For intKolom = 1 To 4
        strEersteLijn = strEersteLijn & Cells(i, intKolom).Text & ";"
    Next
    strEersteLijn = Left(strEersteLijn, Len(strEersteLijn) - 1)
    Print #1, strEersteLijn
Next
Close #1
If MsgBox("Verkenner openen om bestand te bekijken?", vbYesNo, "Uitvoer gelukt") = vbYes Then
On Error Resume Next
Set oshell = CreateObject("wscript.shell")
    If Err.Number <> 0 Then
        MsgBox "Niet gelukt", , "Explorer niet beschikbaar"
        On Error GoTo 0
    Else
        Shell "explorer.exe " & FName, vbNormalFocus
    End If
End If
End Sub

 

[gast0199]

Super !

Het werkt perfect!
Bedankt " Warme bakkertje" & "Roncanio"

Met vriendelijk groet,

Bastiaan