依Excel檔名自動儲存在相同名稱目錄

yueh0720

可以依Excel檔名A名稱自動儲存在相同名稱A目錄的B子目錄裡，該如何處裡?
例如：A-B-C.EXCEL
存檔目錄：C:\[A]\[B](子目錄)

Hsieh

回復 1# yueh0720

1. Sub nn()
   
2. ar = Split(ThisWorkbook.Name, "_")
   
3. fs = "C:\" & ar(0) & "\" & ar(1) & "\" & ThisWorkbook.Name
   
4. ThisWorkbook.SaveAs fds
   
5. End Sub

複製代碼

yueh0720

回復 2# Hsieh

    檔案名稱 A-B-C.EXCEL
    已在c:\建立目錄為[A]
    [A]目錄建立子目錄[D]
    將程式碼貼於A-B-C.EXCLE，執行後卻出現超出陣列範圍
   需要修改何地方才能夠依EXCEL檔名儲存到A目錄的D子目錄中

Hsieh

回復 3# yueh0720
沒有規則的問題，是無法自動化的

FAlonso

回復  Hsieh

    檔案名稱 A-B-C.EXCEL
    已在c:\建立目錄為[A]
    [A]目錄建立子目錄[D]
    將 ...
yueh0720 發表於 2010-12-15 15:55

你的問題是,windows系統中沒有excel file名稱所要求文件夾,所以導致錯誤?

1. Sub save_in_particular_folder()
   
2. Dim myarray
   
3. Dim target_folder As String, target_file
   
4. Dim FSOobject As Object
   
5. myarray = Split(ThisWorkbook.Name, ".xls", -1)
   
6. myarray = Split(myarray(0), "-", -1)
   
7. target_folder = "D:\Tony\Excel VBA\" & myarray(0) & "\" & myarray(1)
   
8. target_file = target_folder & "\" & ThisWorkbook.Name
   
9. If Len(Dir(target_folder, vbDirectory)) = 0 Then
   
10.     Set FSOobject = CreateObject("scripting.filesystemobject")
    
11.     FSOobject.createfolder (target_folder)
    
12.     ThisWorkbook.SaveAs target_file
    
13.    Set FSOobject = Nothing
    
14. Else
    
15.    ThisWorkbook.SaveAs target_file
    
16. End If
    
17. End Sub

複製代碼

這是不是例如像這個?