我有以下代碼，但我想對其進行更改，因此輸出僅提供檔案名的第一部分。檔案名采用以下格式。ZipCode_Name_Date. 我只想要Zipcode列印出來的名稱部分。
Option Explicit
Sub GetFileDetails()
Dim objFSO As Scripting.FileSystemObject
Dim objFolder As Scripting.Folder
Dim objFile As Scripting.File
Dim nextRow As Long
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("")
nextRow = Cells(Rows.Count, 1).End(xlUp).Row 1
For Each objFile In objFolder.Files
Cells(nextRow, 1) = objFile.Name
nextRow = nextRow 1
Next
End Sub
uj5u.com熱心網友回復：
請更換Cells(nextRow, 1) = objFile.Name用Cells(nextRow, 1) = Split(objFile.Name, "_")(0)。
uj5u.com熱心網友回復：
提取檔案部分
如果你把它寫成一個函式......
Option Explicit
Function GetFirstFileNamePart( _
ByVal FolderPath As String, _
ByVal FilePartsDelimiter As String) _
As Variant
Dim fsoFolder As Object
With CreateObject("Scripting.FileSystemObject")
If Not .FolderExists(FolderPath) Then Exit Function
Set fsoFolder = .GetFolder(FolderPath)
End With
Dim fCount As Long: fCount = fsoFolder.Files.Count
If fCount = 0 Then Exit Function
Dim Data As Variant: ReDim Data(1 To fCount, 1 To 1)
Dim fsoFile As Object
Dim n As Long
For Each fsoFile In fsoFolder.Files
n = n 1
' This is the place to modify what to return.
' 0 means the part before the first found delimiter.
Data(n, 1) = Split(fsoFile.Name, FilePartsDelimiter)(0)
Next fsoFile
GetFirstFileNamePart = Data
End Function
...您可以在呼叫程序中輕松使用它（調整常量）：
Sub GetFirstFileNamePartTEST()
' Constants
Const FilePartsDelimiter As String = "_"
Dim FolderPath As String
FolderPath = Environ("OneDrive") & "\Documents\"
Const dCol As String = "A"
' Using the function, write the data to a 2D one-based one-column array.
Dim Data As Variant
Data = GetFirstFileNamePart(FolderPath, FilePartsDelimiter)
' Validate.
If IsEmpty(Data) Then
MsgBox "No files found.", vbExclamation
Exit Sub
End If
' Write the data to the range.
Dim ws As Worksheet: Set ws = ActiveSheet ' be more specific
Dim dCell As Range
Set dCell = ws.Cells(ws.Rows.Count, dCol).End(xlUp).Offset(1)
Dim drg As Range: Set drg = dCell.Resize(UBound(Data, 1), UBound(Data, 2))
drg.Value = Data
MsgBox "First filename parts copied.", vbInformation
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/shujuku/361283.html
下一篇：復制格式化的值并粘貼為文本