excel VBA -无法创建文件夹- fso.CreateFolder

c8ib6hqw 于 2023-06-25 发布在其他

关注(0)|答案(1)|浏览(289)

我需要打开文件夹及其子文件夹中的所有文件，并将其保存为相同的名称，但不同的文件扩展名和不同的位置。
由于我不知道如何在一个宏中做到这一点，我决定将其分为2个步骤。
1.创建文件列表，然后使用公式生成输出文件保存位置
1.循环遍历列表，打开，然后另存为公式给出的位置
到目前为止，我有宏创建所需位置的所有文件列表，并将其放置在Excel表中，然后在F列中我添加了公式，为文件保存位置命名。
在A列中，我有源文件的文件夹路径（例如. D：\RDKU\RDKU\2022\02）
列B具有包括扩展名的文件全名（例如. RDKU_01-02-2023_OR_ORLP_0115_20230202143527_RORT_RDKU_0000305583.xls）
列I包含保存文件夹（生成的公式）目标
我在fso.CreateFolder（savePath）上卡住了。
你能检查和建议吗？

Sub KonwertujPliki()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim sourcePath As String
    Dim fileName As String
    Dim savePath As String
    Dim newFileName As String
    Dim wb As Workbook
    Dim fso As Object
    
   
    Set ws = ThisWorkbook.Worksheets("Lista") 
    
    Set fso = CreateObject("Scripting.FileSystemObject")
        
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
   
    For i = 2 To lastRow
    
        sourcePath = ws.Cells(i, "A").Value
                
        fileName = ws.Cells(i, "B").Value
                
        savePath = ws.Cells(i, "I").Value
               
        If fso.FileExists(sourcePath & "\" & fileName) Then
            
            newFileName = Left(fileName, Len(fileName) - 4) & ".xlsm"
            
            If Not fso.FolderExists(savePath) Then
                fso.CreateFolder (savePath)
            End If
          
            Set wb = Workbooks.Open(sourcePath & "\" & fileName)
            
            wb.SaveAs savePath & "\" & newFileName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
            
            wb.Close SaveChanges:=True
        End If
    Next i
    
    MsgBox "Files copied."
End Sub

我尝试了来自各种论坛的不同部分的代码，但它不想像在efull代码上那样工作。我相信这是接近真相的版本。文件夹路径名不超过255个字符
非常感谢你的帮助
亲切的问候
彼得

excel

来源：https://stackoverflow.com/questions/76481132/vba-unable-to-create-folder-fso-createfolder

1条答案

按热度按时间

oug3syen1#

我能想到3个可能的原因，为什么你不能创建路径：

**（a）**缺少特权-如果不允许您创建路径，则您运气不佳。你除了请求许可什么也做不了。
**（B）**无效名称-文件夹（或文件）名称中不允许使用某些字符。再次，你运气不好，需要改变名称。
**（c）**您想要创建一个缺少的文件夹D:\RDKU\RDKU\2022\02，但已经缺少一个父文件夹。如果文件夹2022已经存在，则fso.CreateFolder只能创建文件夹02。您可以通过先创建父文件夹来解决此问题。下面的代码是一个尝试这样做：

Sub createFolder(folder As String)
    ' Works on Windows pathes with drive letter and on UNC pathes
    ' c:\folder\subfolder\subsubfolder
    ' \\server\share\folder\subfolder\subsubfolder
    
    Dim fso As object, path As String, subfolder() As String
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' Split into subfolder names
    subfolder = Split(folder, "\")
    Dim startIndex As Long, i As Long
    If Left(folder, 2) = "\\" Then
        ' UNC path
        ' subfolder(0) and subfolder(1) are empty
        ' We cannot create server and share name, only folders below
        path = "\\" & subfolder(2) & "\" & subfolder(3)
        startIndex = 4
    Else
        path = subfolder(0)
        startIndex = 1
    End If
    
    For i = startIndex To UBound(subfolder)
        path = path & "\" & subfolder(i)
        If Not fso.FolderExists(path) Then
            fso.createFolder path
        End If
    Next
End Sub

赞(0）回复(0）举报 2023-06-25

我来回答

excel VBA -无法创建文件夹- fso.CreateFolder

1条答案

相关问题

热门标签

最新问答