创建目录和新工作簿时出现错误

时间:2019-08-21 20:04:47

标签: excel vba

所以我有一个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)

在我的工作站(安装了一个驱动器)上可以正常工作,但在其他用户电脑上,尝试创建文件夹和文件时却收到错误消息

2 个答案:

答案 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)