批量修改SolidWorks檔案名稱（2樓有補充，17樓有示範，20樓有繁体版，33楼有简体版）

多谢分享。

好牛逼啊，大大

谢谢楼主分享

好东西

看看阿，看看

求密码

在我的电脑上（win7系统，办公软件为office2007，以及WPS），在选择文件后，所选择的文件名称无法填写到电子表格。最后对源代码中浏览文件部分进行了一些改动，现在可以正常运行了。

1. Sub BrowseDialog() '浏览选择文件
   
2.     Dim FilePathName As String
   
3.     Dim i As Integer
   
4.     Dim PathName
   
5.    
   
6.     Dim RowNumber As Integer
   
7.    
   
8.     Range("A3").Activate
   
9.     RowNumber = 3
   
10.    
    
11.    
    
12.     PathName = Cells(RowNumber, 1) '讀取第一個路徑的值
    
13.      
    
14.     '声明一个变量作为一个FileDialog的对象。
    
15.     Dim fd As FileDialog
    
16.    
    
17.     '创建一个FileDialog的对象作为一个文件选择对话框。
    
18.     Set fd = Application.FileDialog(msoFileDialogFilePicker)
    
19.    
    
20.     '声明一个包含路径的变体变量
    
21.     Dim vrtSelectedItem As Variant
    
22.    
    
23.     '使用With...End块引用FileDialog的对象。.
    
24.     With fd
    
25.         .InitialFileName = Cells(1, 2)
    
26.         While Not (PathName = "" Or PathName = 0 Or IsEmpty(PathName)) '直到讀完路徑欄(尋找繼續填寫的位置)
    
27.             RowNumber = RowNumber + 1 '下一列
    
28.             PathName = Cells(RowNumber, 1)
    
29.         Wend '回到>直到讀完路徑欄
    
30. 
    
31.         .AllowMultiSelect = True '设置多选
    
32.         .Filters.Clear '清理现有类型
    
33.         .Filters.Add "SolidWorks", "*.SLDPRT,*.SLDASM,*.SLDDRW" '設定檔案類型
    
34.         .Filters.Add "所有文件", "*.*" '設定檔案類型
    
35.         .FilterIndex = Cells(1, 1)
    
36.         
    
37.         '使用Show方法来显示文件选择器对话框并返回用户的操作。
    
38.         If .Show = -1 Then
    
39.         
    
40.             '通过在FileDialog的SelectedItems集合遍历所有文件名。
    
41.             
    
42.             For Each vrtSelectedItem In .SelectedItems
    
43.                     'vrtSelectedItem是一个包含每个选定项目的路径字符串集合。
    
44.                 FilePathName = vrtSelectedItem '全路径文件名
    
45.                 FilePath = Left(FilePathName, InStrRev(FilePathName, "")) '分解路径名
    
46.                 Filename = Right(FilePathName, Len(FilePathName) - Len(FilePath)) '分解文件名
    
47.                
    
48.                 Cells(RowNumber, 1) = FilePath  '填寫路徑
    
49.                 Cells(RowNumber, 2) = Filename  '填寫檔案名稱
    
50.                 Cells(RowNumber, 3) = Filename  '填寫檔案名稱
    
51.                
    
52.                 Cells(RowNumber, 1).Interior.Pattern = xlNone  '還原儲存格顏色
    
53.                 Cells(RowNumber, 2).Interior.Pattern = xlNone  '還原儲存格顏色
    
54.                 Cells(RowNumber, 3).Interior.Pattern = xlNone  '還原儲存格顏色
    
55.                
    
56.                 RowNumber = RowNumber + 1
    
57.             Next vrtSelectedItem '逐一读取文件名称完成
    
58.         End If
    
59.     End With
    
60.     '将对象变量设置为Nothing。
    
61.     Set fd = Nothing
    
62.    
    
63. End Sub

复制代码

感谢大神，好好学习了

感谢无私奉献。有用呀