回复 1# 菜鸟新上路 的帖子
这两天我也刚做了一个像你这样的程序,我做的内容是将一个文件夹中的所有*csv文件中的某些数据提取出来,然后放到一个EXCEL文件中,,CSV文件跟txt差不多..下面是代码,我是刚学的,代码写的乱七八糟,可是功能实现了,在窗体中需建文件列表框,驱动器列表框,dir列表框,两个文本框,一个命令按钮.
Option Base 1
Private Sub Cmd1_Click()
Dim data(51) As Variant, s As String, i As Integer, k As Long, bb As Integer
Dim x() As String, y As Integer, hh(51) As String, t() As String
bb = 2
h = FreeFile()
Dim j As Integer
j = 0
'Print "C:\Documents and Settings\xuyadong\桌面\CSV" & "\" & File1.FileName
Do While File1.FileName <> "file1"
File1.ListIndex = File1.ListIndex + 1
'Print File1.FileName
Open Dir1.Path & "\" & File1.FileName For Input As h
i = 1
Do While Not EOF(h) '把每一行放到数组data中
Line Input #h, s
data(i) = Trim(Trim(data(i)) & Trim(s) & ",")
i = i + 1
Loop '取值循环结束
Close h
If File1.ListIndex = File1.ListCount - 1 Then
Exit Do
End If
Loop '读文件循环结束
'Print data(1)
'生成EXCEL
Dim XlApp As New Excel.Application
Dim outpath As String
Dim XlWb As New Excel.Workbook
Dim XlSt As New Excel.Worksheet
Set XlApp = CreateObject("Excel.Application")
XlApp.Visible = False
outpath = "C:\Documents and Settings\debug\Desktop\jack.xls"
Set XlWb = XlApp.Workbooks.Open(outpath)
Set XlSt = XlWb.Worksheets("sheet1")
'以下不需处理
For k = 1 To 51
Text1.Text = ""
Text2.Text = ""
For m = 1 To Val(Len(data(k)))
Text1.Text = Trim(Text1.Text) & Mid(Trim(data(k)), m, 1)
If Mid(Trim(data(k)), m, 1) = "," Then
hh(k) = Trim(Text1.Text) '取CSV数据中每个测试项
'Print hh(k)
Exit For
End If
Next m
x() = Split(Trim(data(k)), Trim(Text1.Text)) 'data数组中的一行数据分割完成，形成一个数组
For y = LBound(x) To UBound(x) '将一行数组从第一个元素循环到最后一个
Text2.Text = Trim(Text2.Text) & Trim(x(y)) '按循环将X数组中的每一项放进文本框2中直到放全为止
'Print Trim(x(y));
Next y '此时TEXT2中字符串等于X数组所有
t() = Split(Trim(Text2.Text), ",")
'For i = LBound(t) To UBound(t)
' Print t(i);
Dim mm As Integer
mm = mm + 1 'mm代表行,i代表列
For i = LBound(t) To UBound(t)
' XlSt.Cells(mm, i + 2) = t(i) '一行一行的往EXCEL中放数据
XlSt.Cells(i + 2, mm) = t(i) '一列一列的往EXCEL中放数据
Next i
ProgressBar1.Value = k
Next k
For bb = 5 To UBound(hh)
' XlSt.Cells(bb, 1) = hh(bb) '当前面是行取
XlSt.Cells(1, bb) = hh(bb) '当前面是列取
Next bb
XlWb.Save
XlWb.Close
XlApp.Quit
huihui = MsgBox("it's down in jack.xls")
End Sub
Private Sub Dir1_Change()
File1.Path = Dir1.Path
End Sub
Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub
