Excel：在文件名太长后使用 VBA 和名称表导入文件答案

【问题标题】：Excel: Import files using VBA and name sheets after file name that is too longExcel：在文件名太长后使用 VBA 和名称表导入文件
【发布时间】：2015-10-23 12:32:15
【问题描述】：

我已经修改了我在此处找到的代码，该代码提取文本文件并将数据粘贴到新工作表中。该文件应该将工作表命名为文本文件的名称，但我的文本文件名太大。似乎 excel 表可以有 31 个字符长。如何调整此代码以使用文本文件名的前 31 个字符命名工作表？

我还希望代码提示我选择文件夹目标。我已经尝试了一些东西，但还没有弄清楚。

Sub ImportManyTXTs_test()
Dim strFile As String
Dim ws As Worksheet
strFile = Dir("I:\path\*.lev")
Do While strFile <> vbNullString
Set ws = Sheets.Add
With ws.QueryTables.Add(Connection:= _
    "TEXT;" & "I:\path\" & strFile, Destination:=Range("$A$1"))
    .Name = strFile
    .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 = False
    .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = False
    .TextFileSpaceDelimiter = False
    .TextFileColumnDataTypes = Array(xlYMDFormat, 1, 1)
    .TextFileFixedColumnWidths = Array(22, 13, 13)
    .TextFileTrailingMinusNumbers = True
    .Refresh BackgroundQuery:=False
End With
strFile = Dir
Loop
End Sub

【问题讨论】：

.Name = Left(strFile, 31)

标签： excel vba

【解决方案1】：

将.Name = strFile改为

If Len(strFile) < 31 Then
   .Name = strFile
Else
   .Name = Mid(strFile, 1, 31)
End If

【讨论】：

下面的 SteJ 提出了同样的建议。它似乎不起作用。示例文件名为“1015584_OW174-35_2015_06_22Compensated.lev”

【解决方案2】：

使用LEFT() 函数仅获取文件名的前 31 个字符，如下所示：

Sub ImportManyTXTs_test()
Dim strFile As String
Dim ws As Worksheet
strFile = Dir("I:\path\*.lev")
Do While strFile <> vbNullString
Set ws = Sheets.Add
With ws.QueryTables.Add(Connection:= _
    "TEXT;" & "I:\path\" & strFile, Destination:=Range("$A$1"))
    .Name = LEFT(strFile,31)
    .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 = False
    .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = False
    .TextFileSpaceDelimiter = False
    .TextFileColumnDataTypes = Array(xlYMDFormat, 1, 1)
    .TextFileFixedColumnWidths = Array(22, 13, 13)
    .TextFileTrailingMinusNumbers = True
    .Refresh BackgroundQuery:=False
End With
strFile = Dir
Loop
End Sub

【讨论】：

【解决方案3】：

我设法弄清楚如何让它提示输入文件夹位置，但上述建议都不起作用。工作表仍然获得默认标签。

Sub ImportManyTXTs_test()

Dim foldername As String
With Application.FileDialog(msoFileDialogFolderPicker)
  .AllowMultiSelect = False
  .Show
  On Error Resume Next
  foldername = .SelectedItems(1)
  Err.Clear
  On Error GoTo 0
End With


Dim strFile As String
Dim ws As Worksheet
strFile = Dir(foldername & "\" & "*.lev")
Do While strFile <> vbNullString
Set ws = Sheets.Add
With ws.QueryTables.Add(Connection:= _
    "TEXT;" & foldername & "\" & strFile, Destination:=Range("$A$1"))
    .Name = Left(strFile, 31)
    .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 = False
    .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = False
    .TextFileSpaceDelimiter = False
    .TextFileColumnDataTypes = Array(xlYMDFormat, 1, 1)
    .TextFileFixedColumnWidths = Array(22, 13, 13)
    .TextFileTrailingMinusNumbers = True
    .Refresh BackgroundQuery:=False
End With
strFile = Dir
Loop
End Sub

【讨论】：

【解决方案4】：

' using for each loop

    For Each ws In ThisWorkbook.Sheets
       ws.Rows("1:45").NumberFormat = "@"
       ws.Rows("1:45").Replace _
       What:="=", Replacement:="", _
       SearchOrder:=xlByColumns, MatchCase:=True
    Next

    For Each ws In ThisWorkbook.Sheets
    If Not IsEmpty(ws.Cells(16, 2).Value) Then
    ws.Name = ws.Cells(16, 2).Value
    End If
    Next

我设法通过将它添加到我的代码末尾来解决我的问题。我的数据文件有一个标题，不幸的是它使用了很多“=”，使 excel 将这些项目作为方程式导入。仪器名称在标题中，这是我希望为工作表标记的名称。

不知道为什么用文件名命名不起作用。

【讨论】：