Saving to a netword folder without mapping drive

[JNW]

I am currently making a spreadsheet that will be used by people in many
departments where I work. They all have our public folder on a different
drive letter. When they finish a form in the sheet it is automatically saved
and emailed. Right now, however, in order for the save function to work the
user must have the public folder designated to the same drive letter set in
the code. I want to avoid having to disconnect drives or map drives as we
have multiple public folders that we use. I would like to be able to just
save to the network folder (\\server\public folder\...) without needing a
drive letter. (see what I already have below)

Desperately searching...

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub ResAlertForm_SaveAs()
Application.ScreenUpdating = False

On Error GoTo ErrRoutine
Dim MyPath As String
Dim MyDirName As String
Dim SuggName As String
Dim NewDir As String

' sets the path
MyPath = "Z:\Agent Forms\Reservation Alert Forms"
MyDirName = Sheets("Reservation Alert Form").Range("H8") 'name of resort

' the next intruction tries to create a new directory.
' If a directory by the specified name already exists, it
' returns an error, number 75. This error is managed by
' the ErrRoutine block.
MkDir (MyPath & "\" & MyDirName)
NewDir = MyPath & "\" & MyDirName

' creates the file name (dd_mm_yyyy_xxxxxxRCNA.xls)
SuggName = Sheets("Reservation Alert Form").Range("D13") _
& ("_") & Sheets("Reservation Alert Form").Range("F13") _
& ("_") & Sheets("Reservation Alert Form").Range("H13") _
& ("_") & Sheets("Reservation Alert Form").Range("D21") _
& ".XLS"

'Changes Current Directory
ChDrive NewDir
ChDir NewDir

' Saves the copy of the form to the
ActiveWorkbook.SaveAs (NewDir & "\" & SuggName)
ExitRoutine:

Call ResAlertForm_Email
Exit Sub
ErrRoutine:
' run-time error 75 - Path/File Access error
If Err.Number = 75 Then
Resume Next
Else
MsgBox Err.Number & ": " & Err.Description
Exit Sub
End If

End Sub

 

[Jim Thomlinson]

Can you not just set the path to the full URL/UNC

MyPath = "\\server\public folder\\Agent Forms\Reservation Alert Forms"

 

[Dave Peterson]

After you change your code using Jim's suggestion, you can comment these lines:

'Changes Current Directory
ChDrive NewDir
ChDir NewDir

Since your filesaveas embeds the path anyway.

 

[JNW]

Thanks guys. I don't know what I was doing before. Here is what I ended up
with and it works perfect.

Thanks again...

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim PathName As String
Dim NewPath As String
Dim FileName As Variant
Dim FolderName As Variant

PathName = "\\server\public folder\Agent Forms\Reservation Alert Forms\"
FolderName = Sheets("Reservation Alert Form").Range("H8")

' creates the file name (dd_mm_yyyy_xxxxxxRCNA.xls)
FileName = Sheets("Reservation Alert Form").Range("D13") _
& ("_") & Sheets("Reservation Alert Form").Range("F13") _
& ("_") & Sheets("Reservation Alert Form").Range("H13") _
& ("_") & Sheets("Reservation Alert Form").Range("D21") _
& ".XLS"

' the next intruction tries to create a new directory.
' If a directory by the specified name already exists, it
' returns an error, number 75. This error is managed by
' the ErrRoutine block.
MkDir (PathName & FolderName)
NewPath = PathName & FolderName

' Saves the copy of the form to the new path and chosen file name
ActiveWorkbook.SaveAs (NewPath & "\" & FileName)

ExitRoutine:

Call ResAlertForm_Email
Exit Sub
ErrRoutine:
' run-time error 75 - Path/File Access error
If Err.Number = 75 Then
Resume Next
Else
MsgBox Err.Number & ": " & Err.Description
Exit Sub
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''