FileDialog(msoFileDialogFolderPicker)

ning84

1. Function AddSheet(Str)
   
2.    Dim Sht As Worksheet
   
3.      For Each Sht In ThisWorkbook.Worksheets
   
4.         If Sht.Name = Str Then
   
5.             Set AddSheet = Sht
   
6.             Exit Function
   
7.         End If
   
8.      Next Sht
   
9.      
   
10.      Set AddSheet = Sheets.Add(After:=Worksheets(Worksheets.Count))
    
11.      AddSheet.Name = Str
    
12. End Function

复制代码

'''
Sub SelectFolderMapToRng()
   Dim Sht As Worksheet, Rng As Range, Kk
       Set Rng = Selection
       Set Sht = Rng.Parent
   Dim Fso As FileSystemObject, oFile As File
       Set Fso = New FileSystemObject
   Dim oFolder As Folder
   Dim Ff As FileDialog
   Set Ff = Application.FileDialog(msoFileDialogFolderPicker)
   With Ff
      .Title = ""
      .AllowMultiSelect = True
      .InitialFileName = "F:"
      .Show
      Set oFolder = Fso.GetFolder(.SelectedItems(1))
      
   End With
   Kk = 1
   For Each oFile In oFolder.Files
       With Sht
          Debug.Print UCase(Right(oFile.Name, 5)) = ".PPTX"
          If UCase(Right(oFile.Name, 5)) = ".PPTX" Then
              .Cells(Rng(Kk, 1).Row, 1) = oFile.Name
              AddSheet Replace(UCase(oFile.Name), ".PPTX", "")
              .Cells(Rng(Kk, 1).Row, "Z") = oFile.Path
          End If
       End With
        Kk = Kk + 1
   Next oFile
   
End Sub

大灰狼1976

请问这是分享还是求助啊

ykcbf1100

应该是分享，不是求助。
第一段代码是：新增工作表，如果已有，则不创建

大灰狼1976

建议发帖时选择一个分类，并在帖子内容里做些文字描述，方便他人帮助或学习。

ykcbf1100

大灰狼1976 发表于 2024-8-29 15:30
建议发帖时选择一个分类，并在帖子内容里做些文字描述，方便他人帮助或学习。

楼主经常发这样的帖子，已经习惯了。
自言自语式，把自己的见解发上来。

醉眼看尘世

1. Function AddSheet(Str) As Worksheet
   
2. On Error Resume Next
   
3. Set AddSheet = Worksheets(Str)
   
4. If Err.Number <> 0 Then
   
5.     Set AddSheet = Sheets.Add(After:=Worksheets(Worksheets.Count))
   
6.     AddSheet.Name = Str
   
7. End If
   
8. End Function

复制代码

ning84

ykcbf1100 发表于 2024-8-29 15:46
楼主经常发这样的帖子，已经习惯了。
自言自语式，把自己的见解发上来。

谢谢，自己出题自己解。

也可以这么认为，自己做题的笔记。

ning84

醉眼看尘世 发表于 2024-8-29 15:55

特别不喜欢英On Error. 在哪里出错都搞不清楚。

For each Next 有错就就不能运行，直接解决。

ning84

自己出题自己做，
学习笔记msoFileDialogFilePicker

1. Sub ReadPhotoInfo()
   
2.     Dim Fso As Scripting.FileSystemObject
   
3.         Set Fso = New Scripting.FileSystemObject
   
4.     Dim fDia      As FileDialog
   
5.     Dim oFiles As Files, oFile As file
   
6.     Dim Str
   
7.          Set fDia = Application.FileDialog(msoFileDialogFilePicker)
   
8.          With fDia
   
9.              .Title = ""
   
10.              .AllowMultiSelect = True
    
11.              .InitialFileName = "F:"
    
12.              .Show
    
13.              Debug.Print .SelectedItems.Count
    
14.              Stop
    
15.              For ii = 1 To .SelectedItems.Count
    
16.                   Debug.Print .SelectedItems(ii)
    
17.                   'Str = .SelectedItems(ii)
    
18.                   Set oFile = Fso.GetFile(.SelectedItems(ii))
    
19.                   Debug.Print oFile.Name, oFile.Path
    
20.              Next ii
    
21.              Stop
    
22.              Stop
    
23.          End With
    
24.          Stop
    
25. End Sub
    

复制代码