通过ADO将CSV文件转换为XLSX文件后快速修改的问题

lzhqlj

通过ADO 使用SQL将 当前目录下的csv快速转换为SQL代码如下Private Sub CommandButton1_Click()

Dim s, name As String
Dim r As Range
Dim lk As Long


Application.ScreenUpdating = False
    p = ThisWorkbook.Path & "\"
    s = ThisWorkbook.Path
s = Right(s, 8)

s = Mid(s, 1, 4) & "-" & Mid(s, 5, 2) & "-" & Mid(s, 7, 2)



    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set cnn = CreateObject("adodb.connection")
    cnn.Open "provider=Microsoft.Ace.OLEDB.12.0;Extended Properties =Excel 12.0;Data Source=" & ThisWorkbook.FullName
    For Each File In Fso.GetFolder(ThisWorkbook.Path).Files

        If File.name Like "*.csv" Then
            f = Replace(File, ".csv", ".xlsx")

            If Fso.FileExists(f) Then Fso.DeleteFile (f)
        Sql = "SELECT * INTO [Excel 12.0 xml;Database=" & f & ";]." & Replace(File.name, ".csv", "") & " FROM [Text;FMT=Delimited;HDR=Yes;DATABASE=" & p & ";]." & File.name


      'cnn.Execute Sql


    Next


MsgBox "OK"
End Sub
-----------
CSV无列名格式如下

92501	8.03	S	500
92501	8.03	S	500
92501	8.03	S	500
92501	8.03	S	1400
92501	8.03	S	8000
92501	8.03	S	27600
92501	8.03	S	200
92501	8.03	S	900
92501	8.03	S	1600
92501	8.03	B	500

需要转换成xlsx格式如下

时间	价格	方向	数量	日期	代码
92501	8.03	S	500	2014/6/7	6001
92501	8.03	S	500	2014/6/7	6001
92501	8.03	S	500	2014/6/7	6001
92501	8.03	S	1400	2014/6/7	6001
92501	8.03	S	8000	2014/6/7	6001
92501	8.03	S	27600	2014/6/7	6001
92501	8.03	S	200	2014/6/7	6001
92501	8.03	S	900	2014/6/7	6001
92501	8.03	S	1600	2014/6/7	6001
92501	8.03	B	500	2014/6/7	6001

-------------------------------------

现在可以将CSV转换成XLSX 但是转换的xlsx文件无列名 和后加的日期、代码列；现在使用

    .Sheets(1).Cells(1, 1) = "成交时间"等实现 速度比较慢
尝试使用  Sql = " alter table [Excel 12.0 xml;Database=" & f & ";]." & Replace(File.name, ".csv", "") & " add  File.name varchar(30)"

             MsgBox Sql
             cnn.Execute Sql
提示自动化错误，我觉的用sql语句可以实现，哪位大神能指导下小弟 谢谢

zhaogang1960

请参考：

1. SQL = "SELECT * INTO [Excel 12.0 xml;Database=" & f & ";]." & Replace(File.Name, ".csv", "") & " FROM (SELECT f1 as 时间,f2 as 价格,f3 as 方向,f4 as 数量,'2014/6/7' as 日期,6001 as 代码 FROM [Text;FMT=Delimited;HDR=no;DATABASE=" & p & ";]." & File.Name & ")"

复制代码

zhaogang1960

下面代码已经按照1楼数据测试成功：
a.rar (16.9 KB, 下载次数: 51)

2015-5-5 23:23 上传

点击文件名下载附件

1. Sub Macro1()
   
2.     Dim cnn As Object, SQL$, p$, f$, Fso As Object, File As Object
   
3.     p = ThisWorkbook.Path & ""
   
4.     Set cnn = CreateObject("adodb.connection")
   
5.     cnn.Open "provider=Microsoft.Ace.OLEDB.12.0;Extended Properties =Excel 12.0;Data Source=" & ThisWorkbook.FullName
   
6.     Set Fso = CreateObject("Scripting.FileSystemObject")
   
7.     For Each File In Fso.GetFolder(ThisWorkbook.Path).Files
   
8.         If File.Name Like "*.csv" Then
   
9.             f = Replace(File, ".csv", ".xlsx")
   
10.             If Fso.FileExists(f) Then Fso.DeleteFile (f)
    
11.             SQL = "SELECT * INTO [Excel 12.0 xml;Database=" & f & ";]." & Replace(File.Name, ".csv", "") & " FROM (SELECT f1 as 时间,f2 as 价格,f3 as 方向,f4 as 数量,'2014/6/7' as 日期,6001 as 代码 FROM [Text;FMT=Delimited;HDR=no;DATABASE=" & p & ";]." & File.Name & ")"
    
12.             cnn.Execute SQL
    
13.         End If
    
14.     Next
    
15.     Set Fso = Nothing
    
16.     cnn.Close
    
17.     Set cnn = Nothing
    
18.     MsgBox "ok"
    
19. End Sub
    

复制代码

lzhqlj

多谢版主
测试成功
我现在需要列的数据 代码 转为变量
  name = Mid(name, 3, 6)
Sql = "SELECT * INTO [Excel 12.0 xml;Database=" & f & ";]." & Replace(File.name, ".csv", "") & " FROM (SELECT f1 as 成交时间,f2 as 成交价格,f3 as 成交方向,f4 as 成交数量数量,'s' as 日期, "&name&" as 代码 FROM [Text;FMT=Delimited;HDR=no;DATABASE=" & p & ";]." & File.name & ")"
显示编译错误：语法错误

lzhqlj

改成 " & name & " 提示自动化错误
MSGBOX sql 观察 已经转换为需要的字段

zhaogang1960

lzhqlj 发表于 2015-5-6 14:46
改成 " & name & " 提示自动化错误
MSGBOX sql 观察 已经转换为需要的字段

如果name 是数字：
SQL = "SELECT * INTO [Excel 12.0 xml;Database=" & f & ";]." & Replace(File.name, ".csv", "") & " FROM (SELECT f1 as 时间,f2 as 价格,f3 as 方向,f4 as 数量,'2014/6/7' as 日期," & name & " as 代码 FROM [Text;FMT=Delimited;HDR=no;DATABASE=" & p & ";]." & File.name & ")"

zhaogang1960

如果name是文本
SQL = "SELECT * INTO [Excel 12.0 xml;Database=" & f & ";]." & Replace(File.name, ".csv", "") & " FROM (SELECT f1 as 时间,f2 as 价格,f3 as 方向,f4 as 数量,'2014/6/7' as 日期,'" & name & "' as 代码 FROM [Text;FMT=Delimited;HDR=no;DATABASE=" & p & ";]." & File.name & ")"

两个程序都在下面附件中：
a.rar (18.07 KB, 下载次数: 37)

2015-5-6 18:52 上传

点击文件名下载附件

lzhqlj

大神给力
这个问题解决了 在实践中又萌生了一个想法 就是将 xlsx文件导入SQL SERVER数据库
也是用SQL


Sql = "SELECT * INTO [Excel 12.0 xml;Database=" & f & ";]." & Replace(file.name, ".csv", "") & " FROM [Excel 12.0 xml;Database=" & f & ";]." & Replace(file.name, ".csv", "") & ""
我理解应该是改变标红的字符串
我的数据库名 股票 用户名 sa 密码123456
这应该是这个程序的最后一个问题了 多谢啊

lzhqlj

Set cnn2 = CreateObject("adodb.connection")
myname = "sa"
myDataBase = "股票"
mypassword = "123456"
serverip = "127.0.0.1"
cnn2.Open "Provider=SQLOLEDB;Initial Catalog=" & myDataBase & ";User ID=" & myname & ";Password=" & mypassword & ";Data Source=" & serverip
Sql = "SELECT * INTO 逐笔数据 FROM [Excel 12.0 xml;Database=" & f & ";]." & Replace(file.name, ".csv", "") & ""


cnn2.Execute Sql
显示自动化错误

lzhqlj

逐笔数据是目标  数据库里的数据表名