|
|
楼主 |
发表于 2008-11-14 14:31
|
显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
原帖由 ilovexiahua 于 2008-11-14 11:01 发表 
zez老师：
你好！
还要向您请教！我的文本文件的格式与您上传的不一样，就是分隔符不一样，所以使用你的方法就出现类型不对的提示。请看附件的文件，如何在导入附件的时候设置分隔符？
将我102楼的代码改一下:Public Sub 方案2()
Dim cnn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim CnnStr As String
Dim myText As String
Dim myPath As String
Dim ws As Worksheet
Dim n As Long, myGroup As Integer
Dim i As Long, j As Long
Dim myData As String, myTable As String
Dim wb As Workbook
Dim cnn2 As ADODB.Connection
Dim rs2 As ADODB.Recordset
Set wb = ThisWorkbook
Set ws = wb.Sheets("Sheet1")
myText = "TEST.txt"
myPath = ThisWorkbook.Path
myData = wb.Path & "\TEST.mdb"
myTable = "ABC"
CnnStr = "Provider=MSDASQL;" _
& "Driver={Microsoft Text Driver (*.txt; *.csv)};" _
& "DBQ=" & myPath
cnn.Open CnnStr
Set cnn2 = New ADODB.Connection
With cnn2
.Provider = "microsoft.jet.oledb.4.0"
.Open myData
End With
Set rs2 = New ADODB.Recordset
rs.Open myText, cnn, adOpenStatic, adLockOptimistic
rs2.Open myTable, cnn2, adOpenKeyset, adLockOptimistic
n = rs.RecordCount
For i = 1 To n
rs2.AddNew
For j = 1 To rs.Fields.Count
rs2.Fields(0) = Left(rs.Fields(0).Value, 9)
rs2.Fields(1) = Mid(rs.Fields(0).Value, 10, 9)
rs2.Fields(2) = Mid(rs.Fields(0).Value, 19, 14)
rs2.Fields(3) = Mid(rs.Fields(0).Value, 34, 3)
Next j
rs2.Update
Application.StatusBar = "正在复制第 " _
& i & " 行数据..." _
& " 共 " & n & " 行数据。"
rs.MoveNext
On Error GoTo 0
Next i
Application.StatusBar = False
rs.Close
rs2.Close
cnn.Close
cnn2.Close
Set rs = Nothing
Set rs2 = Nothing
Set cnn = Nothing
Set cnn2 = Nothing
Set ws = Nothing
End Sub
绿字部份根据你的情况改一下,红字部份是我按你的附件改的
[ 本帖最后由 zez 于 2008-11-14 14:34 编辑 ] |
|
楼主: zez
[复制链接]
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2008-11-9 10:10
