如何使工作表名称等于导入文件的名称？

Question

我有一个名为“127.txt”的文件。我的目标是将此文件导入 excel 工作表，然后将 excel 工作表重命名为文件名（即工作表名称为 127）。我想将文件夹中的每个 .txt 文件导入到同一工作簿的单独工作表中，为了跟踪导入了哪个 .txt 文件，我希望工作表名称是 .txt 文件的名称

我当前的代码是

Sub import_data()
'Access text files
Dim CPath As String 'Current work directory
Dim FPath As String 'Directory for .txt files
CPath = CurDir 
FPath = CPath & "\RAW_Data"

'Import text files into seperate sheets
Dim File As String 'File names
File = Dir(FPath & "*.txt") 'returns directory

End Sub

不确定如何从这里开始

Answer 1

导入文本文件

仔细调整常量部分的值，尤其是目标部分。

Option Explicit

Sub ImportData()
    
    Const sSubfolder As String = "\RAW_Data\"
    Const sFilePattern As String = "*"
    Const sFileExtension As String = ".txt"
    
    Const dSubFolder As String = "\Result\"
    Const dBaseName As String = "Result"
    ' The following two '*** are dependent on each other:
    Const dFileExtension As String = ".xlsx" ' ***
    Dim dFileFormat As XlFileFormat: dFileFormat = xlOpenXMLWorkbook ' ***
    
    Dim twb As Workbook: Set twb = ThisWorkbook ' workbook containing this code
    
    Dim sFolderPath As String: sFolderPath = twb.Path & sSubfolder
    If Len(Dir(sFolderPath, vbDirectory)) = 0 Then Exit Sub ' wrong folder
    
    Dim sfeLen As Long: sfeLen = Len(sFileExtension)
    Dim sFileName As String
    sFileName = Dir(sFolderPath & sFilePattern & sFileExtension)
    
    Application.ScreenUpdating = False
    
    Dim swb As Workbook
    Dim sws As Worksheet
    Dim swbBaseName As String
    
    Dim dwb As Workbook
    Dim dws As Worksheet
    Dim dwsCount As Long
    
    Do While Len(sFileName) > 0
        dwsCount = dwsCount + 1
        
        Set swb = Workbooks.Open(sFolderPath & sFileName)
        Set sws = swb.Worksheets(1)
        
        If dwsCount = 1 Then
            sws.Copy
            Set dwb = ActiveWorkbook
            Set dws = dwb.Worksheets(1)
        Else
            swb.Worksheets(1).Copy After:=dwb.Sheets(dwb.Sheets.Count)
            Set dws = ActiveSheet
        End If
        
        swbBaseName = Left(sFileName, Len(sFileName) - sfeLen)
        On Error Resume Next
            dws.Name = swbBaseName
        On Error GoTo 0
                   
        swb.Close SaveChanges:=False
                   
        sFileName = Dir
    Loop
         
'    Dim dFolderPath As String: dFolderPath = twb.Path & dSubFolder
'    ' Create the subfolder if it doesn't exist.
'    If Len(Dir(dFolderPath, vbDirectory)) = 0 Then
'        MkDir dFolderPath
'    End If
'
'    dwb.SaveAs twb.Path & dSubFolder & dBaseName & dFileExtension, dFileFormat
'    dwb.Close
    
    Application.ScreenUpdating = True
    
    MsgBox "Text files imported: " & dwsCount, vbInformation

End Sub

如何使工作表名称等于导入文件的名称？

How to make worksheet name equal to the name of the imported file?

import

excel

vba

worksheet

导入文本文件