Office中国论坛/Access中国论坛

标题: Excel批量导入TXT数据问题 [打印本页]

作者: dostpy    时间: 2008-8-21 02:12
标题: Excel批量导入TXT数据问题
请问:现在我有近千个TXT文本数据,0001.txt~0999.txt,每一个都需要单独导入新的Excel工作表,数据——导入外部数据——导入数据,然后设置一些,完成之后,另存为0001.xls~0999.xls。

每一个的过程虽然很简单都一模一样,但是我现在有近千个,那还不累死人啦?!请问有什么批处理的方法吗?用宏可以吗?如果可以的话请看下面我录制的语句,需要修改什么地方?!据说把路径文件名改成变量就行了?怎样修改,谢谢!

Sub Macro1()
'
' Macro1 Macro
' 宏由 User 录制,时间: 2008-8-21
'

'
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;D:\xxx\0001.txt" _
        , Destination:=Range("A1"))
        .Name = "AIDC-0121"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 936
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileOtherDelimiter = "|"
        .TextFileColumnDataTypes = Array(2, 1, 2, 1, 1, 1, 1, 1, 1, 2, 9)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    ActiveWorkbook.SaveAs Filename:= _
        "D:\xxx\0001.xls", FileFormat:= _
        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False
End Sub
作者: liwen    时间: 2008-8-21 10:23
Sub Macro1()
on error resume next
'未作测试
For i=1 to 999
filename=format(i,"0000")
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;D:\xxx\" & filename & ".txt" _
        , Destination:=Range("A1"))
        .Name = "AIDC-0121"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 936
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileOtherDelimiter = "|"
        .TextFileColumnDataTypes = Array(2, 1, 2, 1, 1, 1, 1, 1, 1, 2, 9)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    ActiveWorkbook.SaveAs Filename:= _
        "D:\xxx\" & filename & "..xls", FileFormat:= _
        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False
next
End Sub
作者: ycxchen    时间: 2008-8-21 11:42
For i=1 to 999换成For i=0 to 999  行吗?
作者: liwen    时间: 2008-8-22 14:27
Sub test()
On Error Resume Next
Set fs = Application.FileSearch
With fs
    .LookIn = ThisWorkbook.Path
    .Filename = "*.txt"
    If .Execute > 0 Then
       If MsgBox("本文件夹下有" & .FoundFiles.Count & " 文件需要导入,确认导入吗?", vbYesNo, "导入确认") = vbNo Then Exit Sub
        For i = 1 To .FoundFiles.Count
            filenameStr = Mid(Left(.FoundFiles(i), Len(.FoundFiles(i)) - 4), Len(ThisWorkbook.Path) + 2)
            
         Workbooks.Add
      
                With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & ThisWorkbook.Path & "\" & filenameStr & ".txt", Destination:= _
        Range("A1"))
        .Name = filenameStr
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 936
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileOtherDelimiter = "|"
        .TextFileColumnDataTypes = Array(2, 1, 2, 1, 1, 1, 1, 1, 1, 2, 9)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
   
         ChDir ThisWorkbook.Path
          ActiveWorkbook.SaveAs Filename:= _
         ThisWorkbook.Path & "\" & filenameStr & ".xls", FileFormat:= _
        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False
    ActiveWindow.Close
      
            
        Next i
    Else
        MsgBox "没有需要导入的文件"
    End If
End With
End Sub
作者: dostpy    时间: 2008-8-22 18:04
标题: 回复 4# 的帖子
版主老大,弱弱的问一下,在哪里设置文件的导入路径啊?怎么导入??[:30]
作者: dostpy    时间: 2008-8-22 19:09
老大,好像因为那句ThisWorkbook.Path 所以必须先在需要转换的目录打开或新建一个工作簿,然后才可以吧。。。我是这样才行的

请问,可以把那句ThisWorkbook.Path 改成绝对路径吗?比如C:\xxxx
作者: pureshadow    时间: 2008-8-23 00:00
这个.....这个......
貌似可以直接用EXCEL打开TXT
作者: liwen    时间: 2008-8-25 10:04
原帖由 dostpy 于 2008-8-22 19:09 发表
老大,好像因为那句ThisWorkbook.Path 所以必须先在需要转换的目录打开或新建一个工作簿,然后才可以吧。。。我是这样才行的

请问,可以把那句ThisWorkbook.Path 改成绝对路径吗?比如C:\xxxx


实践是检验真理的唯一标准,自己动手替换试试就知道了。
作者: dostpy    时间: 2008-8-25 18:09
版主这段程序写得很好啊,有很多值得我这个新手回味、学习的地方,谢谢liwen版主不仅 授人以鱼,而且最重要的是授人以渔!太感谢了!
作者: dostpy    时间: 2008-8-25 19:09
liwen版主,你真是太帅了!!!刚才用你这段程序修改了一下,又搞定一个类似的任务,再一次衷心感谢!![:50]
作者: chuyuchun    时间: 2008-8-26 08:11
excel还能这样玩 不错
作者: 众叛亲离    时间: 2010-2-25 16:38
首先谢谢版主共享这么好的一个程序!想问一下,就是我的数据不是以“|”为做分隔符的,请问这个怎么处理好?谢谢
作者: 方漠    时间: 2010-2-25 17:06
选固定宽度就可以了.以下是你的文件打开时录的代码.

    Workbooks.OpenText Filename:="D:\test.txt", Origin:=936, StartRow:=1, _
        DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(17, 1), Array(82, 1) _
        ), TrailingMinusNumbers:=True
作者: 众叛亲离    时间: 2010-2-25 17:09
是固定宽度可以没错,想批量!请问要代替前面那个的哪一段!请指点
作者: 方漠    时间: 2010-2-26 12:54
With  .... END WITH 中间那一段参数,具体需要你自己逐个将参数替换尝试一下.

...
.TextFileParseType = xlDelimited
....




欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/) Powered by Discuz! X3.3