Excel VBA 程序从文件名中获取信息

Question

我创建了一个 Excel VBA 代码，其目的是从文件名中获取信息并将其导出到 excel 中。除了跳过第一个文件名之外，该代码可以正常工作。这是我第一次在 VBA 中编码，因此将不胜感激。提前致谢！

代码如下：

Sub Get_Model_File_Names()
    Dim xRow As Long
    Dim xDirect, xFname

    'DIRECTORY TO SELECT FOLDER FROM
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Please select a folder"
        .Show

        'LOCATES FILES
        If .SelectedItems.Count <> 0 Then
            xDirect = .SelectedItems(1) & "\"
            xFname = Dir(xDirect)

            'LOOPS THROUGH EACH FILE NAME IN FOLDER
            Do While xFname <> ""

                'EXTRACT INFORMATION FROM FILE NAME
                xFname = Left(Dir, 10)
                DrawingNumb = Left(xFname, 7)
                RevNumb = Mid(xFname, 10, 2)

                'INSERT INFO INTO EXCEL
                ActiveCell.Offset(xRow, 0) = DrawingNumb
                ActiveCell.Offset(xRow, 1) = RevNumb
                xRow = xRow + 1
             Loop

        End If
    End With
End Sub

• 分

Answer 1

移动xFname = Left(Dir, 10)，使其位于ActiveCell.Offset(xRow, 1) = RevNumb之后

调用xFname = Left(Dir,10) 正在选择目录中的下一个文件。

xFname = Dir(xDirect) 在进入循环之前获取第一个文件。需要先处理那个。

我现在正在运行，没有任何错误：

Sub Get_Model_File_Names()
Dim xRow As Long
Dim xDirect, xFname

'DIRECTORY TO SELECT FOLDER FROM
With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Please select a folder"
    .Show

    'LOCATES FILES
    If .SelectedItems.Count <> 0 Then
        xDirect = .SelectedItems(1) & "\"
        xFname = Left(Dir(xDirect), 10)

        'LOOPS THROUGH EACH FILE NAME IN FOLDER
        Do While xFname <> ""

            'EXTRACT INFORMATION FROM FILE NAME
            DrawingNumb = Left(xFname, 7)
            RevNumb = Mid(xFname, 10, 2)

            'INSERT INFO INTO EXCEL
            ActiveCell.Offset(xRow, 0) = DrawingNumb
            ActiveCell.Offset(xRow, 1) = RevNumb
            xFname = Left(Dir(), 10)
            xRow = xRow + 1
         Loop

    End If
End With

结束子