Excel macro trying to change save path text

Question

trying to work out this code

Sub SplitAndExportCSV2()

Dim ws As Worksheet

Dim lastRow As Long

Dim startRow As Long

Dim chunkSize As Long

Dim partNum As Integer

Dim tempWS As Worksheet

Dim savePath As String

Dim rowCount As Long

Dim lastFileName As String

Dim prevFileName As String

Dim fso As Object, ts As Object, tsLast As Object

Dim i As Long, Col As Long

Dim baseFileName As String

' Settings

chunkSize = 1000

startRow = 2

partNum = 1

Set ws = ThisWorkbook.Sheets(1)

lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

' Ask user for save folder

With Application.FileDialog(msoFileDialogFolderPicker)

    .Title = "Select folder to save CSV files"

    If .Show <> -1 Then Exit Sub

    savePath = .SelectedItems(1) & "\"

End With

Application.ScreenUpdating = False

Dim lastChunkRows As Long

Dim totalParts As Integer

Do While startRow <= lastRow

    rowCount = Application.Min(chunkSize, lastRow - startRow + 1)

    lastChunkRows = rowCount

    totalParts = partNum

    ' Add temporary worksheet

    Set tempWS = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))

    tempWS.Name = "Temp_" & partNum

    ' Insert header line

    tempWS.Range("A1").Value = "materials"

    ws.Rows(1).Copy Destination:=tempWS.Rows(2)

    ' Copy data

    For i = 0 To rowCount - 1

        For Col = 1 To ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column

            tempWS.Cells(i + 3, Col).Value = "'" & ws.Cells(startRow + i, Col).Text

        Next Col

    Next i

    ' Save temp sheet as CSV

    

    baseFileName = Mid(ThisWorkbook.Name, 1, InStrRev(ThisWorkbook.Name, ".") - 1)

    lastFileName = savePath & baseFileName & " (" & partNum & ")" & ".csv"

    

    If partNum > 1 Then

        prevFileName = savePath & baseFileName & "_part_" & (partNum - 1) & ".csv"

    End If

    tempWS.Copy

    With ActiveWorkbook

        .SaveAs fileName:=lastFileName, FileFormat:=xlCSV

        .Close SaveChanges:=False

    End With

    

    ' Clean up temp sheet

    Application.DisplayAlerts = False

    tempWS.Delete

    Application.DisplayAlerts = True

    startRow = startRow + chunkSize

    partNum = partNum + 1

Loop

' If last chunk is small, append it to previous file and delete it

If lastChunkRows < 500 And totalParts > 1 Then

    Set fso = CreateObject("Scripting.FileSystemObject")

    If fso.FileExists(lastFileName) And fso.FileExists(prevFileName) Then

        ' Open last file to read (skip first two lines)

        Set tsLast = fso.OpenTextFile(lastFileName, 1)

        Dim linesToAppend As String

        Dim lineCount As Long: lineCount = 0

        Do Until tsLast.AtEndOfStream

            Dim lineText As String

            lineText = tsLast.ReadLine

            lineCount = lineCount + 1

            If lineCount > 2 Then

                linesToAppend = linesToAppend & lineText & vbCrLf

            End If

        Loop

        tsLast.Close

        ' Append to previous file

        Set ts = fso.OpenTextFile(prevFileName, 8)

        ts.Write linesToAppend

        ts.Close

        ' Delete the last file

        fso.DeleteFile lastFileName, True

    End If

End If

Application.ScreenUpdating = True

MsgBox "Done! Files saved in: " & savePath

End Sub

Answer 1

Hi @Nick B, 

Thank you for posting your question in the Microsoft Q&A forum.  

First, as I understand it, your need is to modify the save path logic within your Excel macro. This would prevent it from prompting the user to select a folder every time it runs, and instead, automatically save to a specific, pre-determined path. Is that correct? 

Could you please tell me which version of Excel you're using? You can find this by going to: Excel > File > Account > About Excel. 

Based on the documentation you provided and common scenarios, I've found a few options that might work for you. I'm sending them for your review. 

Currently, your macro uses a file dialog box for the user to select the save folder: 

VBA 
With Application.FileDialog(msoFileDialogFolderPicker) .Title = "Select folder to save CSV files" If .Show <> -1 Then Exit Sub savePath = .SelectedItems(1) & "\" End With  

Then, it constructs the lastFileName using this savePath: 

VBA 
lastFileName = savePath & baseFileName & " (" & partNum & ")" & ".csv"  

If you want to change this save path programmatically instead of asking the user every time, here are your options: 

Option 1: Hardcode the Save Path 

If the save path will always be the same, you can simply define it directly in your code. 

VBA 
Sub SplitAndExportCSV2() ' ... (your existing Dim statements) ... ' Settings chunkSize = 1000 startRow = 2 partNum = 1 ' --- MODIFICATION START --- ' Define your desired save path directly Dim fixedSavePath As String fixedSavePath = "C:\Your\Desired\Folder" ' <--- Change this to your preferred path! savePath = fixedSavePath ' --- MODIFICATION END --- Set ws = ThisWorkbook.Sheets(1) lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row ' Remove or comment out the FileDialog block if you hardcode the path ' With Application.FileDialog(msoFileDialogFolderPicker) ' .Title = "Select folder to save CSV files" ' If .Show <> -1 Then Exit Sub ' savePath = .SelectedItems(1) & "" ' End With Application.ScreenUpdating = False ' ... (rest of your code) ... End Sub  

Note: Make sure the folder specified in fixedSavePath actually exists, or your macro will throw an error when trying to save the files. 

Option 2: Get the Save Path from a Cell in Excel 

You could store the desired save path in a specific cell on one of your worksheets. This allows for easier changes without editing the VBA code directly. 

For example, if you put the save path in cell A1 of a sheet named "Settings": 

VBA 
Sub SplitAndExportCSV2() ' ... (your existing Dim statements) ... ' Settings chunkSize = 1000 startRow = 2 partNum = 1 ' --- MODIFICATION START --- ' Get save path from a cell (e.g., Sheet "Settings", Cell A1) On Error GoTo ErrorHandler savePath = ThisWorkbook.Sheets("Settings").Range("A1").Value If Right(savePath, 1) <> "" Then savePath = savePath & "" ' Ensure trailing backslash ' --- MODIFICATION END --- Set ws = ThisWorkbook.Sheets(1) lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row ' Remove or comment out the FileDialog block ' With Application.FileDialog(msoFileDialogFolderPicker) ' .Title = "Select folder to save CSV files" ' If .Show <> -1 Then Exit Sub ' savePath = .SelectedItems(1) & "" ' End With Application.ScreenUpdating = False ' ... (rest of your code) ... Exit Sub ErrorHandler: MsgBox "Error: Could not retrieve save path from 'Settings' sheet or path is invalid. Please ensure Sheet 'Settings' exists and cell A1 contains a valid folder path.", vbCritical Application.ScreenUpdating = True End Sub  

Notes: 

• You'll need a sheet named "Settings" (or whatever you choose) and a valid path in cell A1. 
• I've included basic error handling for cases where the sheet or cell isn't found, or if the path is missing a trailing backslash. 

Option 3: Use the Workbook's Current Path 

If you want the CSVs to be saved in the same folder where your Excel macro workbook is located, you can use ThisWorkbook.Path. 

VBA 
Sub SplitAndExportCSV2() ' ... (your existing Dim statements) ... ' Settings chunkSize = 1000 startRow = 2 partNum = 1 ' --- MODIFICATION START --- ' Set savePath to the current workbook's directory savePath = ThisWorkbook.Path & "" ' --- MODIFICATION END --- Set ws = ThisWorkbook.Sheets(1) lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row ' Remove or comment out the FileDialog block ' With Application.FileDialog(msoFileDialogFolderPicker) ' .Title = "Select folder to save CSV files" ' If .Show <> -1 Then Exit Sub ' savePath = .SelectedItems(1) & "" ' End With Application.ScreenUpdating = False ' ... (rest of your code) ... End Sub  

Please review these options and let me know which suits how you'd like to manage the save path for your macro. Once you've chosen your preferred method, remember to remove or comment out the Application.FileDialog block so it no longer prompts the user for a folder selection. 

If there's anything else at all I can assist with, or if you have any further questions, please don't hesitate to reach out. I'm always here to listen and support you. 

Looking forward to your reply!  

---

If the answer is helpful, please click "Accept Answer" and kindly upvote it. If you have extra questions about this answer, please click "Comment". 

Note: Please follow the steps in our documentation to enable e-mail notifications if you want to receive the related email notification for this thread.