将文件名解析为excel vba答案

【问题标题】：Parsing file names to excel vba将文件名解析为excel vba
【发布时间】：2018-05-11 20:37:27
【问题描述】：

我正在尝试隔离我从包含一系列文件的文件夹中获得的地址更改，这些文件的名称包含地址更改。请参阅我包含的第一张图片作为我从中绘制的文件夹的示例。我遍历文件夹并将原始地址和新地址输出到 Excel 表。我遇到的问题是并非所有文件名都相同，因此我目前无法从文件名中提取正确的地址更改信息。包含的第二张照片是输出的照片，黄色文件是我的脚本无法迭代的文件名。如果有人对如何扩大我可以处理的案例数量有任何建议，请参阅下面的当前代码。

Dim AddChng As Worksheet

If sheetExists("AddressChange") Then    'create a new sheet if one doesn't exist
    Set AddChng = ThisWorkbook.Sheets("AddressChange")
Else
    Set AddChng = ThisWorkbook.Sheets.Add(After:=Sheets(Sheets.Count))
    AddChng.Name = "AddressChange"
End If
AddChng.UsedRange.Delete shift:=xlUp    'clear the sheet
AddChng.Range("A1").Value = "Old Name"  'set up
AddChng.Range("B1").Value = "New Name"
AddChng.Activate
AddChng.Range("A2").Select
Dim StrFile As String
'Change this to the directory containing all Address Change Circulation emails
'This will Pull in a list and, to the best of its ability make two columns that hold the data for
'the old and the new address
StrFile = Dir(Range("AddressChangeFolderPath").Value)
Dim Names() As String
Dim StrName
Do While Len(StrFile) > 0
    CheckVal = InStr(1, StrFile, "Address Change Circulation -", vbTextCompare) + _
        InStr(1, StrFile, "Address Change Circulation from ", vbTextCompare)
    If CheckVal <> 1 Then   'if the email does not fit the standard, just place it in the cell and
                            'move on to the next entry
        Selection.Value = StrFile
        Selection.Interior.Color = RGB(255, 255, 0) 'highlight the cell
        Selection.Offset(1, 0).Select
    Else
        StrName = Right(StrFile, Len(StrFile) - 29) 'trim to the correct size - probably not the
                                                    'best way to do this but it works
        If Left(StrName, 4) = "from" Then
            StrName = Right(StrName, Len(StrName) - 5)
        ElseIf Left(StrName, 2) = "om" Then
            StrName = Right(StrName, Len(StrName) - 3)
        End If
        StrName = Left(StrName, Len(StrName) - 4)
        Changes = Split(StrName, " and ")
        For Each Change In Changes
            Names = Split(Change, " to ")

            If Len(Names(0)) < 5 Then
                Selection.Value = Names(0) & Right(Names(1), Len(Names(1)) - Len(Names(0)))
            Else
                Selection.Value = Names(0)
            End If
            If UBound(Names) >= 1 Then 'this is a zero indexed array, checking greater than or
                                       'equal to 1 will check if there are two or more entries
                Selection.Offset(0, 1).Value = Names(1) ' in the event that there is no " to " in
                                                'the file name and it hasn't been handeled already
            End If
            Selection.Offset(1, 0).Select 'select the next cell to accept the next entry
        Next
    End If

    StrFile = Dir
Loop

MsgBox "Make sure to QAQC the new table and update any fields that haven't been properly " & _
    "filled in by the automation."

结束子

【问题讨论】：

嗯，我在这里看到的一些一致性是新地址总是可以确定的，而不考虑字符串。只需检查“ to”并将其用作分隔符。然后倒退到“from”或“-”以获取旧地址

标签： excel vba

【解决方案1】：

“..并非所有文件名都相同，所以..”我希望如此。

您显然必须将“地址更改自”添加到“CheckVal = ..”指令中。并添加所有其他可能的变化！

我建议您单独检查每个案例并单独处理每个案例。在一个“其他”中处理所有情况必须是错误的。恕我直言。

【讨论】：