从单元格中提取文本，并使用vba将文本粘贴到相应的列中

我有一个电子表格，其数据组织如下：

用户将根据需要插入多个或任意多个文本文件，因此每次用户导入新文本文件时，数据将放置在上一次导入的下方，因此每次导入文本文件时，文件路径、深度、A0、A180等都会出现。 我希望能够在“读取日期”列下获得每个文件的相应日期和时间（2003-11-03 17-52-04）。但是我不知道该怎么做

任何提示/帮助都将不胜感激

以下是我导入数据的代码：

Sub Import_Textfiles()
Dim fName As String, LastRow As Long

LastRow = Range("A" & Rows.Count).End(xlUp).Row + 2

fName = Application.GetOpenFilename("Text Files (*.txt), *.txt")

If fName = "False" Then Exit Sub

    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & fName, _
        Destination:=Range("A" & LastRow))
        .Name = "2001-02-27 14-48-00"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1)
        .TextFileFixedColumnWidths = Array(14, 14, 8, 16, 12, 14)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Range("W16").Select
    ActiveWindow.SmallScroll Down:=0

    Dim strShortName As String
    Dim strInitialDir As String


    'Adding Updating Location to Excel Sheet:

    Dim sourceCol As Integer, rowCount As Integer, currentRow As Integer
    Dim currentRowValue As String

    sourceCol = 1   'column A has a value of 1
    rowCount = Cells(Rows.Count, sourceCol).End(xlUp).Row

    strShortName = fName

    'for every row, find the first blank cell and select it
    For currentRow = 1 To rowCount
        currentRowValue = Cells(currentRow, sourceCol).Value
        If IsEmpty(currentRowValue) Or currentRowValue = "" Then
            Cells(currentRow, sourceCol).Select
            Cells(currentRow, sourceCol) = ("Updating Location: " & strShortName)
        End If
    Next

End Sub

---

您可以尝试将其添加到

With

块末尾附近：

    .Refresh BackgroundQuery:=False
    .ResultRange.Columns(.ResultRange.Columns.Count + 1) = Now
End With

---

我用下面的代码让它做我需要它做的事情：

子导入_Textfiles（） Dim fName为字符串，最后一行为长

LastRow=范围（“A”&行数）。结束（xlUp）。行数+2

fName=Application.GetOpenFilename（“文本文件（*.txt），*.txt”）

如果fName=“False”，则退出子系统

With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & fName, _
    Destination:=Range("A" & LastRow))
    .Name = "2001-02-27 14-48-00"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .TextFilePromptOnRefresh = False
    .TextFilePlatform = 437
    .TextFileStartRow = 1
    .TextFileParseType = xlFixedWidth
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = True
    .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = False
    .TextFileSpaceDelimiter = False
    .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1)
    .TextFileFixedColumnWidths = Array(14, 14, 8, 16, 12, 14)
    .TextFileTrailingMinusNumbers = True
    .Refresh BackgroundQuery:=False


End With
Range("W16").Select
ActiveWindow.SmallScroll Down:=0

Dim strShortName As String
Dim strInitialDir As String


'Adding Updating Location to Excel Sheet:

Dim sourceCol As Integer, rowCount As Integer, currentRow As Integer
Dim currentRowValue As String
Dim fileDate1 As String
Dim fileDate2 As String


sourceCol = 1   'column A has a value of 1
rowCount = Cells(Rows.Count, sourceCol).End(xlUp).Row

strShortName = fName
fileDate1 = Mid(fName, InStrRev(fName, "\") + 1)
fileDate2 = Left(fileDate1, 19)


'for every row, find the first blank cell and select it
For currentRow = 1 To rowCount
    currentRowValue = Cells(currentRow, sourceCol).Value
    If IsEmpty(currentRowValue) Or currentRowValue = "" Then
        Cells(currentRow, sourceCol).Select
        Cells(currentRow, sourceCol) = ("Updating Location: " & strShortName)
        Cells((currentRow + 1), (sourceCol + 7)).Select
        Cells((currentRow + 1), (sourceCol + 7)) = "Reading Date"
        Cells((currentRow + 1), (sourceCol + 7)).Select
        Cells((currentRow + 2), (sourceCol + 7)) = fileDate2

    End If
Next

端接头

---

谢谢你的其他建议

你能展示你的代码吗？这样我们就可以看到你尝试了什么，并从那时起帮助你了？当然可以！这是我将文本文件数据导入工作表的代码：谢谢Slai，但我不希望今天的日期在该列中，我希望日期在文件路径中。