使用VBA将excel表格中的文本提取

我试图编写一个VBA脚本，从文本文档中提取信息并将其制表到相应的列中。代码基于https://stackoverflow.com/questions/51635537/extract-data-from-text-file-into-excel/51636080. 我在进行多次提取时遇到问题

示例文本

年龄：35岁
军衔：中尉
类别:义工
事件发生日期：1997年6月22日
死亡日期：1997年6月22日
死亡原因：被抓住或被困
死亡性质：烧伤
活动类型：提前软管管线/火灾攻击（包括荒地）
紧急任务：是的
工作类型：现场火灾
固定物业用途：住宅
纪念基金资料：
年龄:18
职级：消防员
类别:义工
事件发生日期：1997年6月16日
死亡日期：1997年6月17日
死因：被击中
死亡的性质：创伤
活动类型：驾驶/操作车辆/设备
紧急任务：是的
职责类型：响应
固定资产用途：不适用
纪念基金资料：

工作代码的输出

期望输出

失败的代码输出

问题：VBA代码在列“F”之后失败，不会移动到下一行

工作代码：

Sub ExtractData()
Dim filename As String, nextrow As Long, MyFolder As String
Dim MyFile As String, text As String, textline As String, filedate As String
Dim filenum As Integer
Dim idx%

MyFolder = "/Users/user/Downloads/test/"
MyFile = Dir(MyFolder & "*.txt")

nextrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1

Do While MyFile <> ""

    Open (MyFolder & MyFile) For Input As #1

    'nextrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1

    Do Until EOF(1)
        Line Input #1, textline 'read a line

    idx = InStr(textline, "Age:") ' if has date, set it but not move to the next ROW
    If idx > 0 Then
        ActiveSheet.Cells(nextrow, "A").Value = Right(textline, Len(textline) - InStr(textline, ":") - 1)
    End If

    idx = InStr(textline, "Rank:") ' if has date, set it but not move to the next ROW
    If idx > 0 Then
        ActiveSheet.Cells(nextrow, "B").Value = Right(textline, Len(textline) - InStr(textline, ":") - 1)
    End If

    idx = InStr(textline, "Classification:") ' if has date, set it but not move to the next ROW
    If idx > 0 Then
        ActiveSheet.Cells(nextrow, "C").Value = Right(textline, Len(textline) - InStr(textline, ":") - 1)
    End If

    idx = InStr(textline, "Incident date:") ' if has date, set it but not move to the next ROW
    If idx > 0 Then
        ActiveSheet.Cells(nextrow, "D").Value = Right(textline, Len(textline) - InStr(textline, ":") - 1)
    End If

    idx = InStr(textline, "Date of death:") ' if has date, set it but not move to the next ROW
    If idx > 0 Then
        ActiveSheet.Cells(nextrow, "E").Value = Right(textline, Len(textline) - InStr(textline, ":") - 1)
    End If

    idx = InStr(textline, "Cause of death:")
    If idx > 0 Then
        ActiveSheet.Cells(nextrow, "F").Value = Right(textline, Len(textline) - InStr(textline, ":") - 1)

        nextrow = nextrow + 1 'now move to next row

    End If

Loop
Close #1
MyFile = Dir()

Loop
End Sub

Sub-ExtractData（）
Dim文件名为字符串，nextrow为长，MyFolder为字符串
Dim MyFile作为字符串、text作为字符串、textline作为字符串、filedate作为字符串
Dim filenum作为整数
Dim idx%
MyFolder=“/Users/user/Downloads/test/”
MyFile=Dir（MyFolder&“*.txt”）
nextrow=ActiveSheet.Cells（Rows.Count，“A”）.End（xlUp）。Row+1
当我的文件“”时执行此操作
打开（MyFolder&MyFile）作为#1输入
'nextrow=ActiveSheet.Cells（Rows.Count，“A”）.End（xlUp）.行+1
直到EOF（1）为止
行输入#1，文本行“读取行”
idx=InStr（文本行，“年龄：”），如果有日期，则设置它，但不移动到下一行
如果idx>0，则
ActiveSheet.Cells（nextrow，“A”）.Value=Right（textline，Len（textline）-InStr（textline，“：”）-1）
如果结束
idx=InStr（文本行，“秩：”），如果有日期，则设置它，但不移动到下一行
如果idx>0，则
ActiveSheet.Cells（nextrow，“B”）.Value=Right（textline，Len（textline）-InStr（textline，“：”）-1）
如果结束
idx=InStr（文本行，“分类：”），如果有日期，则设置它，但不移动到下一行
如果idx>0，则
ActiveSheet.Cells（nextrow，“C”）.Value=Right（textline，Len（textline）-InStr（textline，“：”）-1）
如果结束
idx=InStr（文本行，“事件日期：”），如果有日期，则设置它，但不移动到下一行
如果idx>0，则
ActiveSheet.Cells（nextrow，“D”）.Value=Right（textline，Len（textline）-InStr（textline，“：”）-1）
如果结束
idx=InStr（文本行，“死亡日期：”），如果有日期，则设置它，但不移动到下一行
如果idx>0，则
ActiveSheet.Cells（nextrow，“E”）.Value=Right（textline，Len（textline）-InStr（textline，“：”）-1）
如果结束
idx=InStr（文本行，“死亡原因：”）
如果idx>0，则
ActiveSheet.Cells（nextrow，“F”）.Value=Right（textline，Len（textline）-InStr（textline，“：”）-1）
nextrow=nextrow+1'现在移动到下一行
如果结束
环
关闭#1
MyFile=Dir（）
环
端接头

失败的代码

Sub ExtractData()
Dim filename As String, nextrow As Long, MyFolder As String
Dim MyFile As String, text As String, textline As String, filedate As String
Dim filenum As Integer
Dim idx%

MyFolder = "/Users/josephheaton/Downloads/test/"
MyFile = Dir(MyFolder & "*.txt")

nextrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1

Do While MyFile <> ""

    Open (MyFolder & MyFile) For Input As #1

    'nextrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1

    Do Until EOF(1)
    Line Input #1, textline 'read a line

    idx = InStr(textline, "Age:") ' if has date, set it but not move to the next ROW
    If idx > 0 Then
        ActiveSheet.Cells(nextrow, "A").Value = Right(textline, Len(textline) - InStr(textline, ":") - 1)
    End If

    idx = InStr(textline, "Rank:")
    If idx > 0 Then
        ActiveSheet.Cells(nextrow, "B").Value = Right(textline, Len(textline) - InStr(textline, ":") - 1)
    End If

    idx = InStr(textline, "Classification:")
    If idx > 0 Then
        ActiveSheet.Cells(nextrow, "C").Value = Right(textline, Len(textline) - InStr(textline, ":") - 1)
    End If

    idx = InStr(textline, "Incident date:") 
    If idx > 0 Then
        ActiveSheet.Cells(nextrow, "D").Value = Right(textline, Len(textline) - InStr(textline, ":") - 1)
    End If

    idx = InStr(textline, "Date of death:")
    If idx > 0 Then
        ActiveSheet.Cells(nextrow, "E").Value = Right(textline, Len(textline) - InStr(textline, ":") - 1)
    End If

    idx = InStr(textline, "Cause of death:")
    If idx > 0 Then
        ActiveSheet.Cells(nextrow, "F").Value = Right(textline, Len(textline) - InStr(textline, ":") - 1)
    End If

    idx = InStr(textline, "Nature of death:")
    If idx > 0 Then
        ActiveSheet.Cells(nextrow, "G").Value = Right(textline, Len(textline) - InStr(textline, ":") - 1)
    End If

    idx = InStr(textline, "Activity:")
    If idx > 0 Then
        ActiveSheet.Cells(nextrow, "H").Value = Right(textline, Len(textline) - InStr(textline, ":") - 1)
    End If

    idx = InStr(textline, "Emergency:")
    If idx > 0 Then
        ActiveSheet.Cells(nextrow, "I").Value = Right(textline, Len(textline) - InStr(textline, ":") - 1)
    End If

    idx = InStr(textline, "Duty:")
    If idx > 0 Then
        ActiveSheet.Cells(nextrow, "J").Value = Right(textline, Len(textline) - InStr(textline, ":") - 1)
    End If

    idx = InStr(textline, "Property type:")
    If idx > 0 Then
        ActiveSheet.Cells(nextrow, "L").Value = Right(textline, Len(textline) - InStr(textline, ":") - 1)
    End If


    idx = InStr(textline, "Memorial fund info:")
    If idx > 0 Then
        ActiveSheet.Cells(nextrow, "L").Value = Right(textline, Len(textline) - InStr(textline, ":") - 1)

        nextrow = nextrow + 1 'now move to next row

    End If

Loop
Close #1
MyFile = Dir()

Loop
End Sub

Sub-ExtractData（）
Dim文件名为字符串，nextrow为长，MyFolder为字符串
Dim MyFile作为字符串、text作为字符串、textline作为字符串、filedate作为字符串
Dim filenum作为整数
Dim idx%
MyFolder=“/Users/josephheaton/Downloads/test/”
MyFile=Dir（MyFolder&“*.txt”）
nextrow=ActiveSheet.Cells（Rows.Count，“A”）.End（xlUp）。Row+1
当我的文件“”时执行此操作
打开（MyFolder&MyFile）作为#1输入
'nextrow=ActiveSheet.Cells（Rows.Count，“A”）.End（xlUp）.行+1
直到EOF（1）为止
行输入#1，文本行“读取行”
idx=InStr（文本行，“年龄：”），如果有日期，则设置它，但不移动到下一行
如果idx>0，则
ActiveSheet.Cells（nextrow，“A”）.Value=Right（textline，Len（textline）-InStr（textline，“：”）-1）
如果结束
idx=仪表（文本行，“等级：”）
如果idx>0，则
ActiveSheet.Cells（nextrow，“B”）.Value=Right（textline，Len（textline）-InStr（textline，“：”）-1）
如果结束
idx=仪表（文本行，“分类：”）
如果idx>0，则
ActiveSheet.Cells（nextrow，“C”）.Value=Right（textline，Len（textline）-InStr（textline，“：”）-1）
如果结束
idx=仪表（文本行，“事件日期：”）
如果idx>0，则
ActiveSheet.Cells（nextrow，“D”）.Value=Right（textline，Len（textline）-InStr（textline，“：”）-1）
如果结束
idx=InStr（文本行，“死亡日期：”）
如果idx>0，则
ActiveSheet.Cells（nextrow，“E”）.Value=Right（textline，Len（textline）-InStr（textline，“：”）-1）
如果结束
idx=InStr（文本行，“死亡原因：”）
如果idx>0，则
ActiveSheet.Cells（nextrow，“F”）.Value=Right（textline，Len（textline）-InStr（textline，“：”）-1）
如果结束
idx=InStr（文本行，“死亡的性质：”）
如果idx>0，则
ActiveSheet.Cells（nextrow，“G”）.Value=Right（textline，Len（textline）-InStr（textline，“：”）-1）
如果结束
idx=仪表（文本行，“活动：”）
如果idx>0，则
ActiveSheet.Cells（nextrow，“H”）.Value=Right（textline，Len（textline）-InStr（textline，“：”）-1）
如果结束
idx=仪表（文本行，“紧急情况：”）
如果idx>0，则
ActiveSheet.Cells（nextrow，“I”）.Value=Right（textline，Len（textline）-InStr（textline，“：”）-1）
如果结束
idx=仪表（文本行，“工作：”）
如果idx>0，则
ActiveSheet.Cells（nextrow，“J”）.Value=Right（textline，Len（textline）-InStr（textline，“：”）-1）
如果结束
idx=InStr（文本行，“属性类型：”）
如果idx>0，则
ActiveSheet.Cells（nextrow，“L”）.Value=Right（textline，Len（textline）-InStr（textline，“：”）-1）
如果结束
idx=InStr（文本行，“纪念基金信息：”）
如果idx>0，则
ActiveSheet.Cells（nextrow，“L”）.Value=Right（textline，Len（textline）-InStr（textline，“：”）-1）
nextrow=nextrow+1'现在移动到下一行
如果结束
环
关闭#1
MyFile=Dir（）
环