|
楼主 |
发表于 2024-1-18 15:40
|
显示全部楼层
学习学习再学习,Fso的应用
- Private Sub ReadFolderToSheetName()
- Dim Fso As New FileSystemObject, oFolder As Folder
- Set Fso = New FileSystemObject
- Dim Sht As Worksheet
- Dim Str
- Set Sht = ThisWorkbook.ActiveSheet
- With Application.FileDialog(msoFileDialogFolderPicker)
- If .Show Then
- Set oFolder = Fso.GetFolder(.SelectedItems(1))
-
- Sht.Name = oFolder.Name
- End If
- End With
- End Sub
- Private Sub TraverseSheetCreatFolder()
- Dim Fso As New FileSystemObject
- Dim oFile As File, oFolder As Folder
- Set Fso = New FileSystemObject
-
- Dim Sht As Worksheet, ii As Integer, PathName
-
- For Each Sht In ThisWorkbook.Sheets
- If InStr(Sht.Name, "Sheet") = 0 Then
- ii = ii + 1
- 'Debug.Print ii, Sht.Name
- PathName = ThisWorkbook.Path & "" & Sht.Name
- If Fso.FolderExists(PathName) = True Then
- Set oFolder = Fso.GetFolder(PathName)
- 'Debug.Print oFolder.Name, oFolder.Path
- Else
- 'Debug.Print oFolder.Path
-
- Set oFolder = Fso.CreateFolder(PathName)
- End If
-
- End If
-
- Next Sht
- End Sub
- Sub CopyFilePasteFile()
- Dim Fso As New FileSystemObject
- Dim oFile As File, oFile1 As File
- Set Fso = New FileSystemObject
- Dim Rng As Range, Sht As Worksheet
- Set Rng = Selection
- Set Sht = Rng.Parent
- Dim PathName, PathName1
- Dim ii, jj, Cc, Rr, Str
- PathName = ThisWorkbook.Path & "" & "model.Pptm"
- PathName1 = ThisWorkbook.Path & "" & "del.Pptm"
-
- Set oFile = Fso.GetFile(PathName)
-
- For ii = 6 To Sheets.Count
- Set Sht = Sheets(ii)
- PathName = ThisWorkbook.Path & "" & Sht.Name & "Model.Pptm"
- Debug.Print ii - 5, PathName
- oFile.Copy PathName, True
- Next ii
- Stop
- End Sub
复制代码 |
|