所以我有一个VBA脚本，该脚本通过userform接收用户输入，然后创建一个输出工作簿以包含数据并将其另存为.csv。我遇到的问题是，当我想创建将文件保存到目录中的文件夹时，每个工作站都不一样，因为我的公司使用Microsoft One Drive来更改桌面的文件路径。我已经在计算机上运行了此功能，但是每次我将表单发送给用户进行测试时，他们都会收到运行时错误，并且应用程序无法在桌面上创建文件夹。有一次，该文件夹在我的代码中不存在时被保存在“我的文档”中。希望您能提供帮助。
我已经多次使用if语句更改代码，以验证文件路径，但是我仍然看到相同的问题
User = Environ("Username") 'set the current users username to the User variable
WBpath = "C:\Users\" & User & "\OneDrive - CompanyName\Desktop" 'windows directory where the file will go
WBpath2 = "C:\Users\" & User & "\Desktop" 'windows directory where the file will go
WBName = "BulkUpload" & UserForm1.TextBox5.value & ".csv" 'the name of the file
WBFile = WBpath & "\BulkUploadFiles\" & WBName 'full file path we will be saving the file in
WBFile2 = WBpath2 & "\BulkUploadFiles\" & WBName 'full file path we will be saving the file in
For Each wb In Workbooks 'loop through each open excel workbook and perform the below action
If wb.Name = WBName Then 'perform the below action only if the currently selected workbook has the same name as the output workbook
Workbooks(WBName).Close 'close the selected excel workbook
End If 'done checking if the file is already open
Next 'go to the next open excel workbook
'make the directory to save the bulkupload file to. create it if it doesnt already exist.
If Dir(WBpath, vbDirectory) <> "" Then 'check is the folder already exists
ChDir WBpath 'change the directory to WBPath
If Dir(WBpath & "\BulkUploadFiles\", vbDirectory) = "" Then
MkDir "BulkUploadFiles" 'create the output folder
End If
Set NewBook = Workbooks.Add 'create the output workbook
With NewBook 'set the properties for the output workbook
.Title = WBName 'add the workbook title
.Subject = WBName 'add the workbook subject
.SaveAs filename:=WBFile, FileFormat:=xlCSV, local:=True 'save the output workbook to the assigned directory as a CSV file
End With 'done setting file properties
End If
If Dir(WBpath2, vbDirectory) <> "" Then 'check is the folder already exists
ChDir WBpath2 'change the directory to WBPath2
If Dir(WBpath2 & "\BulkUploadFiles\", vbDirectory) = "" Then
MkDir "BulkUploadFiles" 'create the output folder
End If
Set NewBook = Workbooks.Add 'create the output workbook
With NewBook 'set the properties for the output workbook
.Title = WBName 'add the workbook title
.Subject = WBName 'add the workbook subject
.SaveAs filename:=WBFile2, FileFormat:=xlCSV, local:=True 'save the output workbook to the assigned directory as a CSV file
End With 'done setting file properties
End If
Workbooks(WBName).Sheets("BulkUpload" & UserForm1.TextBox5.value).Name = "Sheet1" 'rename the first sheet in the output workbook back to Sheet1 so we can reference it correctly later
Workbooks(WBName).Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Sheet3" 'add a new sheet to the output workbook
Workbooks(WBName).Sheets("Sheet3").Visible = xlSheetHidden 'hide the new sheet we just made (Sheet3)
在我的工作站（安装了一个驱动器）上可以正常工作，但在其他用户电脑上，尝试创建文件夹和文件时却收到错误消息
答案 0 :(得分：2)
代替此：
name="text"您可以跳过ChDir WBpath 'change the directory to WBPath
If Dir(WBpath & "\BulkUploadFiles\", vbDirectory) = "" Then
MkDir "BulkUploadFiles" 'create the output folder
End If
，而只使用类似这样的内容：
ChDir fPath = WBpath & "\BulkUploadFiles"
If Dir(fPath, vbDirectory) = "" Then
MkDir fPath
End If
如果用户的当前工作文件夹位于其他驱动器上，则不会设置工作文件夹
编辑：这对我有用，但是我不确定将多个工作表添加到CSV格式文件时要做什么，因为CSV只能包含一个“工作表”
ChDir答案 1 :(得分：0)
这是我更新的代码。我尝试使用if语句来验证路径，但这在除我的之外的所有工作站上仍然失败。
Dim NewBook As Variant
Dim WBpath, WBpath2, WBName, WBFile, WBFile2, WBDir, WBDir2, Fpath, Fpath2 As String
Dim User As String
Dim WS As Worksheet
Dim wb As Workbook
User = Environ("Username") 'set the current users username to the User variable
WBpath = "C:\Users\" & User & "\OneDrive - CompanyName\Desktop" 'windows directory where the file will go
WBpath2 = "C:\Users\" & User & "\Desktop" 'windows directory where the file will go
WBName = "BulkUpload" & UserForm1.TextBox5.value & ".csv" 'the name of the file
WBFile = WBpath & "\BulkUploadFiles\" & WBName 'full file path we will be saving the file in
WBFile2 = WBpath2 & "\BulkUploadFiles\" & WBName 'full file path we will be saving the file in
For Each wb In Workbooks 'loop through each open excel workbook and perform the below action
If wb.Name = WBName Then 'perform the below action only if the currently selected workbook has the same name as the output workbook
Workbooks(WBName).Close 'close the selected excel workbook
End If 'done checking if the file is already open
Next 'go to the next open excel workbook
'make the directory to save the bulkupload file to. create it if it doesnt already exist.
Fpath = WBpath & "\BulkUploadFiles\"
If Dir(WBpath2, vbDirectory) <> "" Then
If Dir(Fpath, vbDirectory) = "" Then
MkDir Fpath
Set NewBook = Workbooks.Add 'create the output workbook
With NewBook 'set the properties for the output workbook
.Title = WBName 'add the workbook title
.Subject = WBName 'add the workbook subject
.SaveAs filename:=WBFile, FileFormat:=xlCSV, local:=True 'save the output workbook to the assigned directory as a CSV file
End With 'done setting file properties
End If
如果结束
Fpath2 = WBpath2＆“ \ BulkUploadFiles \”
If Dir(WBpath2, vbDirectory) <> "" Then
If Dir(Fpath2, vbDirectory) = "" Then
MkDir Fpath
Set NewBook = Workbooks.Add 'create the output workbook
With NewBook 'set the properties for the output workbook
.Title = WBName 'add the workbook title
.Subject = WBName 'add the workbook subject
.SaveAs filename:=WBFile2, FileFormat:=xlCSV, local:=True 'save the output workbook to the assigned directory as a CSV file
End With 'done setting file properties
End If
如果结束 Workbooks（WBName）.Sheets（“ BulkUpload”＆UserForm1.TextBox5.value）.Name =“ Sheet1”'将输出工作簿中的第一张工作表重命名为Sheet1，以便我们稍后可以正确地引用它
Workbooks(WBName).Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Sheet3" 'add a new sheet to the output workbook
Workbooks(WBName).Sheets("Sheet3").Visible = xlSheetHidden 'hide the new sheet we just made (Sheet3)