VBA在映射驱动器上保存到CurDir

I created a macro that needs some tweaking but cannot find an answer to one part. Based on the user input of officename, it opens up the SaveAs dialog box and creates a folder in the current directory of the file + today's date. When saved locally this works fine. When the file is moved to the mapped drive the save as dialog box opens to my local downloads folder. I've tried a few things but all have the same result.

我创建了一个需要调整但无法找到一个部分的答案的宏。根据officename的用户输入,它打开SaveAs对话框,并在文件的当前目录+今天的日期创建一个文件夹。在本地保存时,这很好用。当文件移动到映射的驱动器时,“另存为”对话框将打开到我的本地下载文件夹。我尝试了一些东西,但都有相同的结果。

When I debug and print the path it is correct. I believe the problem lies somewhere with how I'm using the FileSystemObject and the ChDir even though from what I've read these should be working fine the way they're being used. The complete sub is pasted below.

当我调试并打印路径时,它是正确的。我相信问题在于我如何使用FileSystemObject和ChDir,尽管从我读过的内容中它们应该可以正常使用它们。完整的子粘贴在下面。

Sub SaveAs()
Dim file_name As Variant
Dim xdir As String
Dim fso
Dim saveDate As String

Set fso = CreateObject("Scripting.FileSystemObject")
saveDate = Date
saveDate = Replace(saveDate, "/", ".")
'Debug.Print "Test" & " "; officeName <-- good
Fname = officename & " " & Date
Fname = Replace(Fname, "/", "-")
Debug.Print Fname <-- good
xdir = ThisWorkbook.Path & "\" & officename
Debug.Print xdir <-- good
If Not fso.FolderExists(xdir) Then
 fso.CreateFolder (xdir)
End If

ChDir (xdir)

' Get the file name.
file_name = Application.GetSaveAsFilename(Fname, _
    FileFilter:="Excel Macro-Enabled Workbook,*.xlsm,All Files,*.*", _
    Title:="Save As File Name")

' See if the user canceled.
If file_name = False Or "False.xls" Then Exit Sub

1 个解决方案

#1

Updated code below is now working beautifully on all machines! Thanks for the input!

以下更新的代码现在可以在所有机器上运行得很好!感谢您的投入!

ChDir (xdir)

Sub SaveAs()
Dim file_name As Variant
Dim xdir As String
Dim fso
Dim saveDate As String
Dim driveLetter As String <-- NEW VARIABLE    

Set fso = CreateObject("Scripting.FileSystemObject")
saveDate = Date
saveDate = Replace(saveDate, "/", ".")
'Debug.Print "Test" & " "; officeName <-- good
Fname = officename & " " & Date
Fname = Replace(Fname, "/", "-")
Debug.Print Fname <-- good
xdir = ThisWorkbook.Path & "\" & officename
Debug.Print xdir <-- good
If Not fso.FolderExists(xdir) Then
 fso.CreateFolder (xdir)
End If

////new code
driveLetter = Left(xdir, 1)
ChDrive (driveLetter)
////new code

ChDir (xdir)

' Get the file name.
file_name = Application.GetSaveAsFilename(Fname, _
FileFilter:="Excel Macro-Enabled Workbook,*.xlsm,All Files,*.*", _
Title:="Save As File Name")

' See if the user canceled.
If file_name = False Or "False.xls" Then Exit Sub