我有一個名為“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
不知道從這里怎么走
uj5u.com熱心網友回復：
匯入文本檔案
- 仔細調整常量部分中的值，尤其是目標部分。
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
轉載請註明出處，本文鏈接：https://www.uj5u.com/shujuku/415383.html
標籤：
上一篇：根據單元格值連接每列中的值
下一篇：Excel-按順序將行組合在一起