Using VBA to Save To A Network Drive by Default

[String23]

Hi everyone,

I have been struggling to get a macro working all day and wanted to see if anyone had any advice. Basically, I have a macro that copies the active sheet and saves it as a .txt file. Right now, when the Save As prompt opens, it autofills the file name with a value from a specific cell and the default save location is C:\Users\User\Documents. However, I would like to change the default save location for this file to be the file directory where the original Excel file is located. The problem I'm having is that the file will be stored on a network location (\\Folder1\Folder2\ExcelFile.xlsm). I was able to get the macro to work on a local drive using ChDrive/ChDir, but this doesn't work on a network location. Does anyone know how to do this? My code is below (I left in the code I was using for the local drives that doesn't work when the file is stored on the network drive).

Essentially I want the Save As prompt to open in \\Folder1\Folder2\ (an unmapped network location).

Sub SaveToTxt()
    Dim xRet As Long
    Dim xFileName As Variant
    On Error GoTo ErrHandler:
    ChDrive Left(ActiveWorkbook.Path, 2) 'only works on local drives
    ChDir ActiveWorkbook.Path 'only works on local drives
    xFileName = Application.GetSaveAsFilename(ActiveWorkbook.Sheets("SheetName").Range("B3"), "Text File (*.txt), *.txt", , "Save your file as a Tab Delimited TXT")
    If xFileName = False Then Exit Sub
    If Dir(xFileName) <> "" Then
        xRet = MsgBox("File '" & xFileName & "' exists.  Overwrite?", vbYesNo + vbExclamation, "Overwrite File?")
        If xRet <> vbYes Then
            Exit Sub
        Else
            Kill xFileName
        End If
    End If
    ActiveSheet.Copy
    ActiveWorkbook.SaveAs xFileName, xlText
    If ActiveWorkbook.Name <> ThisWorkbook.Name Then
        ActiveWorkbook.Close False
    End If
My_Exit:
    Exit Sub
ErrHandler:
    MsgBox Err.Description, , "Error"
End Sub

Thanks in advance!

 

[bobsan42]

What do you have in cell B3 on SneetName?
Try to put the required path in B3 to use it as InitialFilename parameter.

 

[Alex Blakenburg]

I don't have a network drive to test it on but what happens if you simply:
Delete the 2 Ch lines
and assuming the new file name is in B3 modify the xFileName code.

(won't work on OneDrive or Sharepoint)

    ' Remove --> ChDrive Left(ActiveWorkbook.Path, 2) 'only works on local drives
    ' Remove --> ChDir ActiveWorkbook.Path 'only works on local drives
    xFileName = ActiveWorkbook.Path & "\" & ActiveWorkbook.Sheets("SheetName").Range("B3")
    xFileName = Application.GetSaveAsFilename(xFileName _
                , "Text File (*.txt), *.txt", , "Save your file as a Tab Delimited TXT")

 

[String23]

This worked perfectly, thank you so much! I was hoping it would be a simple fix. The updated code is below just in case.

Sub SaveToTxt()
    Dim xRet As Long
    Dim xFileName As Variant
    On Error GoTo ErrHandler:
    xFileName = ActiveWorkbook.Path & "\" & ActiveWorkbook.Sheets("SheetName").Range("B3")
    xFileName = Application.GetSaveAsFilename(xFileName _
            , "Text File (*.txt), *.txt", , "Save your file as a Tab Delimited TXT")
    If xFileName = False Then Exit Sub
    If Dir(xFileName) <> "" Then
        xRet = MsgBox("File '" & xFileName & "' exists.  Overwrite?", vbYesNo + vbExclamation, "Overwrite File?")
        If xRet <> vbYes Then
            Exit Sub
        Else
            Kill xFileName
        End If
    End If
    ActiveSheet.Copy
    ActiveWorkbook.SaveAs xFileName, xlText
    If ActiveWorkbook.Name <> ThisWorkbook.Name Then
        ActiveWorkbook.Close False
    End If
My_Exit:
    Exit Sub
ErrHandler:
    MsgBox Err.Description, , "Error"
End Sub

Thanks again!

 

[String23]

I don't have a network drive to test it on but what happens if you simply:
Delete the 2 Ch lines
and assuming the new file name is in B3 modify the xFileName code.

(won't work on OneDrive or Sharepoint)

    ' Remove --> ChDrive Left(ActiveWorkbook.Path, 2) 'only works on local drives
    ' Remove --> ChDir ActiveWorkbook.Path 'only works on local drives
    xFileName = ActiveWorkbook.Path & "\" & ActiveWorkbook.Sheets("SheetName").Range("B3")
    xFileName = Application.GetSaveAsFilename(xFileName _
                , "Text File (*.txt), *.txt", , "Save your file as a Tab Delimited TXT")

Sorry, meant to reply to you above, but it worked perfectly! Thanks!

 

[String23]

What do you have in cell B3 on SneetName?
Try to put the required path in B3 to use it as InitialFilename parameter.

Alex responded with a nice solution, but the B3 cell contains a unique header for the data sheet (in this format ##-XXXXXXXX##).

Thanks for responding!

 

[Alex Blakenburg]

Sorry, meant to reply to you above, but it worked perfectly! Thanks!

Thanks for letting us know. Glad we were able to help.