如何能不打开EXCEL文件且将EXCEL数据写入TXT？？

zhaogang1960

bluexuemei 发表于 2013-5-9 23:07
schema.ini中设置
[目标文件.txt]
ColNameHeader=false

短信收到，你已经写出来了，schema.ini可以通过代码生成，用完后再删除它，如果要生成csv或用逗号分割的文本文件，则不需要schema.ini：

1. Sub ADO生成csv文件() '或用逗号分割的文本文件(.txt)
   
2.     Dim cnn, SQL$, s$, f$
   
3.     Set cnn = CreateObject("adodb.connection")
   
4.     f = ThisWorkbook.Path & "\目标文件.csv"
   
5.     If Dir(f) <> "" Then Kill f
   
6.     cnn.Open "provider=microsoft.jet.oledb.4.0;extended properties='excel 8.0;hdr=no';data source=" & ThisWorkbook.Path & "\数据源.xls" '如果有标题，则去掉HDR=No，下同
   
7.     SQL = "select * into [Text;FMT=Delimited;HDR=No;DATABASE=" & ThisWorkbook.Path & "\;].目标文件.csv from [Sheet1$A6:X]"
   
8.     cnn.Execute SQL
   
9.     cnn.Close
   
10.     Set cnn = Nothing
    
11.     MsgBox "ok"
    
12. End Sub
    
13. 
    
14. Sub ADO生成用制表符分割的文本文件()
    
15.     Dim cnn, SQL$, s$, f$
    
16.     Set cnn = CreateObject("adodb.connection")
    
17.     s = "[目标文件.txt]" & vbCrLf & "COLNAMEHEADER = False" & vbCrLf & "Format = TabDelimited"
    
18.     Open ThisWorkbook.Path & "\schema.ini" For Output As #1
    
19.     Print #1, s
    
20.     Close #1
    
21.     f = ThisWorkbook.Path & "\目标文件.txt"
    
22.     If Dir(f) <> "" Then Kill f
    
23.     cnn.Open "provider=microsoft.jet.oledb.4.0;extended properties='excel 8.0;hdr=no';data source=" & ThisWorkbook.Path & "\数据源.xls" '如果有标题，则去掉HDR=No，下同
    
24.     SQL = "select * into [Text;FMT=Delimited;HDR=No;DATABASE=" & ThisWorkbook.Path & "\;].目标文件.txt from [Sheet1$A6:X]"
    
25.     cnn.Execute SQL
    
26.     cnn.Close
    
27.     Set cnn = Nothing
    
28.     Kill ThisWorkbook.Path & "\schema.ini"
    
29.     MsgBox "ok"
    
30. End Sub
    

复制代码

zhaogang1960

请看附件
SQL语句生成文本文件.rar (119.12 KB, 下载次数: 32)

2013-5-9 23:24 上传

点击文件名下载附件

bluexuemei

zhaogang1960 发表于 2013-5-9 23:21
短信收到，你已经写出来了，schema.ini可以通过代码生成，用完后再删除它，如果要生成csv或用逗号分割的文 ...

还是老师写得好，再次感谢！

wanapen

alzeng 发表于 2013-5-9 17:51
等Zamyi更好的方法……

先谢谢alzeng 老师~~~

但是在FOR语句那里我还是没有太懂~~嘿嘿~希望老师别嫌我烦~~~

我试着运用循环跑了一遍，在print #1,str 处会提示错误~~~~还烦请老师再帮帮我~万分感谢~！！！

我的目的 是这样的

比如我有1101.xls-1102.xls-1111.xls-1112.xls

如何能让1101.xls与1102.xls的数据共同写入110.txt
如何能让1111.xls与1112.xls的数据共同写入111.txt

老师辛苦了~~~
987.zip (506.84 KB, 下载次数: 11)

2013-5-10 11:11 上传

点击文件名下载附件

alzeng

1. Sub wrtInTxt()
   
2.     Dim oClp As Object
   
3.     Dim Flnm, Str$, k%, Txtnm$
   
4.     Dim Wb As Workbook, Pth$
   
5. 
   
6.     Set oClp = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
   
7.     Flnm = Application.GetOpenFilename("Excel文件,*.xls", , "请选择", , True)
   
8.     Txtnm = InputBox("请输入你想保存的文本名称:")
   
9.     For k = 1 To UBound(Flnm)
   
10.         Set Wb = GetObject(Flnm(k))
    
11.         Wb.Sheets(1).[A6].CurrentRegion.Copy    '此处假设所有文件格式相同
    
12.         oClp.getfromclipboard: Str = oClp.gettext
    
13.         Pth = Wb.Path
    
14.         [A1].Copy: Wb.Close 0
    
15. 
    
16.         Open Pth & "" & Txtnm & ".txt" For Append As #1
    
17.         Print #1, Str: Reset
    
18.     Next
    
19.     Set oClp = Nothing
    
20.     MsgBox "数据已写入文本中。"
    
21. End Sub

复制代码

alzeng

每次选择的多个文件写入一个文本文件中（名称需输入），如多个文本请多次执行——因为我无法获你哪些文件需要合并，文本文件名称又应该是什么。
以下是两次运行后的结果：

wanapen

alzeng 发表于 2013-5-9 17:51
等Zamyi更好的方法……

alzeng 老师

原来这个
Flnm = Application.GetOpenFilename("Excel文件,*.xls", , "请选择", , True)语句是可以多选的啊 ？？

那老师 如果我想带条件选择呢？比如满足前3位为110的所有XLS，这个该怎么弄呢 ？

就是不用手动选择，让VBA在指定文件夹中选择满足条件的所有EXCEL！

alzeng

wanapen 发表于 2013-5-10 11:43
alzeng 老师

原来这个

手工选择或是选择后设置条件遍历时过滤掉。

——不要指望这个可以人工智能。

Zamyi

1. Sub test()
   
2. Application.DisplayAlerts = False
   
3. Application.ScreenUpdating = False
   
4. fs = Application.GetOpenFilename("Excel文件,*.xls", , "请选择", , True)
   
5. For Each f In fs
   
6.   With GetObject(f)
   
7.     .SaveAs Replace(f, ".xls", ".txt"), xlUnicodeText, False
   
8.     .Close
   
9.   End With
   
10. Next
    
11. Application.DisplayAlerts = True
    
12. Application.ScreenUpdating = True
    
13. End Sub

复制代码