Tabbladen als CSV opslaan met prompt voor bestands naam

[globe]

Ik gebruik al jaren een klein VBA scriptje om 3 tabbladen uit een file op te slaan als CSV

in onderstaand voorbeeld worden er 3 files gemaakt van tabblad Order1, Order2 en order3.
Deze files heten Order1.csv, order2.csv en order3.csv

Dim ws As Worksheet, newWb As Workbook

Application.ScreenUpdating = False
For Each ws In Sheets(Array("Order1", "Order2", "Order3"))
   ws.Copy
   Set newWb = ActiveWorkbook
   With newWb
      .SaveAs ws.Name, xlCSV
      .Close (False)
   End With
Next ws

Nu wil ik voordat de bestanden weggeschreven worden een venster openen waar ik de naam van het bestand kan aangeven en de locatie.

De bestandsnamen moeten dus worden: bestandsnaam_order1.csv etc..

Wie kan me op weg helpen?

 

[edmoor]

Zo?

For Each ws In Sheets(Array("Order1", "Order2", "Order3"))
   ws.Copy
   CSV = Application.GetSaveAsFilename
   With ActiveWorkbook
      .SaveAs CSV & "_" & ActiveSheet.Name & ".csv", xlCSV
      .Close False
   End With
Next ws

 

[snb]

Sub M_snb()
  c00 = InputBox("filename")

  For Each it In Sheets
    it.SaveAs c00 & "_" & it.Name, 23
  Next
End Sub

 

[globe]

top beiden! Ik ga er mee aan de stoei.

 

[globe]

Eh.... wijziging van de plannen.

Ipv zelf een naam invoeren moet de naam van het bestand gehaald worden uit cel C8 van tabblad 'Totals' (eerste tabblad)
Wel moet er een popup komen waar het bestand dient te worden opgeslagen.

Kunnen jullie me daar ook mee op weg helpen?

Ik heb nu onderstaand. Dat werkt prima maar ik wil nog een locatie kunnen meegeven waar de files komen te staan.

Application.ScreenUpdating = False

Klant = Worksheets("totals").Range("c8")
Orderdesc = Worksheets("totals").Range("B6")

For Each ws In Sheets(Array("Order1", "Order2", "Order3"))
   ws.Copy
   'CSV = Application.GetSaveAsFilename
   
   With ActiveWorkbook
      .SaveAs Klant & "_" & Orderdesc & "_" & ActiveSheet.Name & ".csv", xlCSV
      .Close False
   End With
Next ws

 

[snb]

Waarom in verschillende (sub)directories ?

 

[globe]

Bedankt voor je reactie SNB.

Heb ik iets met subdirectories in bovenstaande code, dat is zeker niet de bedoeling.

In jullie oplossingen wordt er een folder én bestandsnaam gevraagd.
Dat wil ik niet, de bestandsnaam wordt in bovenstaande code uit 2 cellen gegenereerd.

Wat ik wel graag zou willen is een popup op welke locatie de bestanden moeten worden opgeslagen.

 

[edmoor]

Je wilt drie bestanden opslaan en je vraagt 2 namen op en een folder?
Dat is niet duidelijk.
Moeten die drie bestanden per stuk in een aparte folder worden opgeslagen?
Het blad Totals kan ik C8 maar 1 naam hebben.

 

[globe]

De 3 bestanden dienen allemaal in dezelfde map te worden opgeslagen. Dat functioneert prima met onderstaande code.

Ik heb nu de volgende code er van gemaakt op basis van jouw antwoord Edmoor:

de bestanden worden dan:

Klantnaam_ordernummer_order1.csv
Klantnaam_ordernummer_order2.csv
Klantnaam_ordernummer_order3.csv

Klant = Worksheets("totals").Range("c8")
Orderdesc = Worksheets("totals").Range("B6")
FolderName = Application.GetSaveAsFilename


For Each ws In Sheets(Array("Order1", "Order2", "Order3"))
   ws.Copy
 
   
   With ActiveWorkbook
      .SaveAs FolderName & Klant & "_" & Orderdesc & "_" & ActiveSheet.Name & ".csv", xlCSV
      .Close False
   End With
Next ws

Dit geeft een Windowsvenster waar ik naar de gewenste map kan gaan maar vraagt tevens een bestandsnaam in te voeren.
Dat laatste wil ik niet, de bestandsnaam wordt immers door de waardes uit de cellen meegegeven.

dus het stukje code

FolderName = Application.GetSaveAsFilenam

vraagt nu een locatie én bestandsnaam, dit zou alleen de locatie moeten zijn.

Hoop dat het zo duidelijker is.

 

[edmoor]

Dan kan je dit gebruiken:

Sub NaarCSV()
    Klant = Worksheets("totals").Range("c8")
    Orderdesc = Worksheets("totals").Range("B6")
    Folder = GetFolder

    For Each ws In Sheets(Array("Order1", "Order2", "Order3"))
       ws.Copy
       With ActiveWorkbook
          .SaveAs Folder & "\" & Klant & "_" & Orderdesc & "_" & ActiveSheet.Name & ".csv", xlCSV
          .Close False
       End With
    Next ws
End Sub

Function GetFolder() As String
    Dim fldr As FileDialog
    Dim sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Selecteer een Folder"
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show = -1 Then sItem = .SelectedItems(1)
    End With
    GetFolder = sItem
    Set fldr = Nothing
End Function

 

[globe]

Edmoor je bent mijn held vandaag.

Dit doet exact wat ik wil.

 

[snb]

Maak in plaats van allerlei bestanden in allerlei directories 1 werkblad met alle gegevens. Die kun je vervolgens filtern/sorteren etc.
Neem afscheid van het papierdenken met kasten, planken, ordners, tab- en schutbladen.

 

[globe]

Helemaal mee eens! Ik ga deze quote uitprinten en aan mijn collega’s geven. Gelukkig wordt het steeds beter hier maar we werken idd met veel te veel losse files waarin tabbladen en niet werkbare data inzitten. Het project waar ik dit voor nodig heb gaat ze laten zien dat het anders kan. Helaas heb ik alleen de drie output csv files nodig om in ons systeem te kunnen verwerken. Maar we zijn op de goede weg.