Opslaan als d.m.v. macro

[rickb1977]

Hallo forumleden,

Ik zou graag een macro maken waarmee ik een bestaand .txt bestand op kan slaan als .xlsx onder dezelfde naam en in dezelfde map.
Dus feitelijk alleen maar een verandering van .txt naar .xlsx

Hoe kan ik dat het beste aanpakken?

Alvast bedankt voor jullie advies.

 

[edmoor]

Je wilt dus in een Excel document een tekstbestand openen, inlezen in een werkblad en dan dat document opslaan met dezelfde naam als het tekstbestand?

 

[rickb1977]

Dat klopt inderdaad. En voor de volledigheid: het is een bestand in het formaat "Tekst (tab is scheidingsteken)"
Deze txt bestanden komen als export uit een softwarepakket maar deze kunnen helaas niet automatisch als xlsx worden geëxporteerd.

Het zou dan handig zijn dit txt bestand te kunnen openen in met 1 druk in dezelfde map als xlsx op te slaan.

 

[edmoor]

Plaats dan een voorbeeld van zo'n tekstbestand.

 

[rickb1977]

Bekijk bijlage voorbeeld exportbestand.txt

 

[edmoor]

Dat zijn alleen de headers en heb ik dus niet veel aan.
Een paar regels met correcte waarden veld zijn er ook voor nodig.

 

[rickb1977]

Bekijk bijlage voorbeeld exportbestand2.txt

Het bestand ziet er zo uit. Ik heb de persoonlijke info even vervangen.

 

[HSV]

Bv.

Doe dit even in een testmap met kopieën van een aantal txt bestanden, ze worden namelijk omgezet naar .xlsx en de txt wordt verwijderd.

Sub hsv()
Dim bestandopen
Application.ScreenUpdating = False
 bestandopen = Dir("C:\users\rick1977\documents\mapnaam\*.txt")
  Do Until bestandopen = ""
     Workbooks.Open "C:\users\rick1977\documents\mapnaam\" & bestandopen
      ActiveWorkbook.SaveAs "C:\users\rick1977\documents\mapnaam\" & Replace(bestandopen, ".txt", ""),51
      ActiveWorkbook.Close True
        Kill "C:\users\rick1977\documents\mapnaam\" & bestandopen
    bestandopen = Dir
  Loop
End Sub

 

[rickb1977]

Beste HSV,

Dat werkt heel mooi. Bedankt daarvoor!

Een aanvullende vraag: stel dat ik dit wil combineren met onderstaande macro, hoe pak ik dat aan?
Dan zou dus elk txt bestand geopend moeten worden, de macro 'opmaak_exportbestand' uitgevoerd moeten worden om vervolgens het bestand op te slaan als .xlsx ipv .txt?

Is dat haalbaar?

Sub opmaak_exportbestand()
'
' opmaak_exportbestand Macro
'

'
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "Totale kilometers"
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[3]C:R[1000]C)"
    Range("H1:I1").Select
    Selection.Font.Bold = True
    Rows("3:3").Select
    Selection.Font.Bold = True
    Columns("A:A").EntireColumn.AutoFit
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A1").Select
End Sub

 

[VenA]

Tussen Workbooks.open en Activeworkbook.saveas

Rows("1:2").Insert
    With Range("H1:I1")
      .Value = Array("Totale kilometers", "=SUM(R[3]C:R[1000]C)")
      .Font.Bold = True
    End With
    Rows(3).Font.Bold = True
    Columns.AutoFit

 

[rickb1977]

Bedankt voor al jullie antwoorden!

Als ik de macro van HSV (zie antwoord 4-9-2017, 19.33 uur) gebruik bij meerdere bestanden tegelijk dan worden de getallen in kolom I (afstand) vanaf het tweede bestand door Excel gemarkeerd als "Getal opgeslagen als tekst". Bij het eerste bestand dat geopend wordt gaat het wel goed.

Hoe kan ik dit oplossen zonder elk bestand handmatig te moeten aanpassen?

 

[VenA]

Bij gaat het bij het eerste bestand al fout.

Probeer het zo eens

Sub hsvVenA()
  Dim bestandopen, c00 As String
  c00 = "E:\Temp\A\"
  Application.ScreenUpdating = False
  bestandopen = Dir(c00 & "*.txt")
  
  Do Until bestandopen = ""
     Workbooks.Open c00 & bestandopen
     Columns(9).Replace ",", "."
     Rows("1:2").Insert
      With Range("H1:I1")
        .Value = Array("Totale kilometers", "=SUM(R[3]C:R[1000]C)")
        .Font.Bold = True
      End With
      Rows(3).Font.Bold = True
      Columns.AutoFit
      ActiveWorkbook.SaveAs c00 & Replace(bestandopen, ".txt", ""), 51
      ActiveWorkbook.Close True
      Kill c00 & bestandopen
    bestandopen = Dir
  Loop
End Sub

 

[rickb1977]

Zo werkt het prima! Heel erg bedankt voor de hulp.