我有一個中文文字檔的格式如下:
SB9000001 王小明 A123456789 550505 104台北市中山區民權東路二段144號8樓 0225007788 800101 199101 B.M.W 自小客 R1234567F 1997 AB8888 5 901026 911026 1757 A
B900001 MR. JAMES GUTIERREZ A123456 601010 330桃園市龍岡里26鄰江南十街80號 034888999 891125 200010 光陽 重型機車 SQ1234567 125 ABC123 2 901125 921125 1322 B
我想要按照固定的欄位轉檔到access 的資料庫中.我寫了一個code也轉成了.但是欄位沒辦法抓的很準.應該是中文的問題!是不是能請各位大哥
指導一下.我的程式碼!是哪裡出問題了!要如何改寫才好!!
Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
'Private dba As Database
Option Explicit
Private Sub EXIT_Click()
End
End Sub
Private Sub Form_Load()
' Set dba = OpenDatabase("r:\ezfly project\db\ezfly.mdb")
Dim connstr As String 'database connection string
'Set conn = New ADODB.Connection
connstr = "provider = Microsoft.Jet.OLEDB.3.51;" & "Data Source = r:\ezfly project\ezfly project\verision 3\ezfly.mdb"
conn.Open connstr
'Set rs = New ADODB.Recordset
'rs.CursorLocation = adUseClient
'rs.Open "EZFLY", conn
', adOpenStatic, adLockBatchOptimistic
End Sub
Private Sub TRANSFER_Click()
Dim strTxtName As String
Dim strTextLine As String 'text line verible
Dim a As String 'test string
Dim Insu_No As String
Dim i As Integer
Dim j As Integer
Dim j1 As Integer
Dim k As Integer
Dim check_chinese As Integer
Dim check_chinese1 As Integer
Dim check_chinese2 As Integer
Dim t As Integer
Dim t1 As Integer
Dim t2 As Integer
Dim c As Integer
Dim c1 As Integer
Dim d2 As Integer
Dim name As String
Dim address As String
Dim car_mark As String
Dim x As Integer
'Insu_No = "保單號碼"
strTxtName = "r:\ezfly project\ezfly project\verision 3\ezfly.txt"
Open strTxtName For Input As #1
rs.Open "EZFLY", conn, adOpenKeyset, adLockPessimistic
Do
Line Input #1, strTextLine
rs.AddNew
rs("保單號碼") = Mid(strTextLine, 1, 10)
i = 0
j = 0
k = 0
c = 0
check_chinese = 0
'投保人中文檢查 check chinese
Do While (i < 31)
check_chinese = LenB(StrConv(Mid(strTextLine, 11 + j, 1), vbFromUnicode))
i = i + IIf(check_chinese = 0, 1, check_chinese)
If check_chinese <> 0 Then
name = name & Mid(strTextLine, 11 + j, 31)
End If
j = j + 1
If check_chinese = 2 Then
c = c + 1
End If
Loop ' i <31
'x = 31 + (31 - check_chinese)
rs("被保險人") = name
'rs("被保險人") = Mid(strTextLine, 11, 28)
rs("身分證字號") = Mid(strTextLine, 42, 11)
rs("生日") = Mid(strTextLine, 53, 7)
'通訊地址中文檢查 check chinese address
Do While (k < 61)
check_chinese1 = LenB(StrConv(Mid(strTextLine, 60, 61), vbFromUnicode))
k = k + IIf(check_chinese1 = 0, 1, check_chinese1)
If check_chinese1 <> 0 Then
address = address & Mid(strTextLine, x + 71, 61)
End If
j1 = j1 + 1
If check_chinese = 2 Then
c1 = c1 + 1
End If
Loop ' k<61
rs("通訊地址") = address
rs("聯絡電話") = Mid(strTextLine, 121, 16)
rs("原始發照日") = Mid(strTextLine, 137, 7)
rs("製造年月") = Mid(strTextLine, 144, 7)
'rs("車輛廠牌") = Mid(strTextLine, 151, 11)
rs("車輛種類") = Mid(strTextLine, 162, 9)
rs("引擎號碼") = Mid(strTextLine, 171, 21)
rs("排氣量") = Mid(strTextLine, 192, 5)
rs("牌照號碼") = Mid(strTextLine, 197, 7)
rs("乘載限制") = Mid(strTextLine, 204, 2)
rs("保險生效日") = Mid(strTextLine, 206, 7)
rs("保險到期日") = Mid(strTextLine, 213, 7)
rs("保費") = Mid(strTextLine, 220, 5)
rs("保險內容") = Mid(strTextLine, 225, 1)
rs.Update
rs.MoveNext
Loop While Not EOF(1)
rs.Close
conn.Close
Close #1
End Sub
非常感謝您得幫忙!!!
SB9000001 王小明 A123456789 550505 104台北市中山區民權東路二段144號8樓 0225007788 800101 199101 B.M.W 自小客 R1234567F 1997 AB8888 5 901026 911026 1757 A
B900001 MR. JAMES GUTIERREZ A123456 601010 330桃園市龍岡里26鄰江南十街80號 034888999 891125 200010 光陽 重型機車 SQ1234567 125 ABC123 2 901125 921125 1322 B
我想要按照固定的欄位轉檔到access 的資料庫中.我寫了一個code也轉成了.但是欄位沒辦法抓的很準.應該是中文的問題!是不是能請各位大哥
指導一下.我的程式碼!是哪裡出問題了!要如何改寫才好!!
Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
'Private dba As Database
Option Explicit
Private Sub EXIT_Click()
End
End Sub
Private Sub Form_Load()
' Set dba = OpenDatabase("r:\ezfly project\db\ezfly.mdb")
Dim connstr As String 'database connection string
'Set conn = New ADODB.Connection
connstr = "provider = Microsoft.Jet.OLEDB.3.51;" & "Data Source = r:\ezfly project\ezfly project\verision 3\ezfly.mdb"
conn.Open connstr
'Set rs = New ADODB.Recordset
'rs.CursorLocation = adUseClient
'rs.Open "EZFLY", conn
', adOpenStatic, adLockBatchOptimistic
End Sub
Private Sub TRANSFER_Click()
Dim strTxtName As String
Dim strTextLine As String 'text line verible
Dim a As String 'test string
Dim Insu_No As String
Dim i As Integer
Dim j As Integer
Dim j1 As Integer
Dim k As Integer
Dim check_chinese As Integer
Dim check_chinese1 As Integer
Dim check_chinese2 As Integer
Dim t As Integer
Dim t1 As Integer
Dim t2 As Integer
Dim c As Integer
Dim c1 As Integer
Dim d2 As Integer
Dim name As String
Dim address As String
Dim car_mark As String
Dim x As Integer
'Insu_No = "保單號碼"
strTxtName = "r:\ezfly project\ezfly project\verision 3\ezfly.txt"
Open strTxtName For Input As #1
rs.Open "EZFLY", conn, adOpenKeyset, adLockPessimistic
Do
Line Input #1, strTextLine
rs.AddNew
rs("保單號碼") = Mid(strTextLine, 1, 10)
i = 0
j = 0
k = 0
c = 0
check_chinese = 0
'投保人中文檢查 check chinese
Do While (i < 31)
check_chinese = LenB(StrConv(Mid(strTextLine, 11 + j, 1), vbFromUnicode))
i = i + IIf(check_chinese = 0, 1, check_chinese)
If check_chinese <> 0 Then
name = name & Mid(strTextLine, 11 + j, 31)
End If
j = j + 1
If check_chinese = 2 Then
c = c + 1
End If
Loop ' i <31
'x = 31 + (31 - check_chinese)
rs("被保險人") = name
'rs("被保險人") = Mid(strTextLine, 11, 28)
rs("身分證字號") = Mid(strTextLine, 42, 11)
rs("生日") = Mid(strTextLine, 53, 7)
'通訊地址中文檢查 check chinese address
Do While (k < 61)
check_chinese1 = LenB(StrConv(Mid(strTextLine, 60, 61), vbFromUnicode))
k = k + IIf(check_chinese1 = 0, 1, check_chinese1)
If check_chinese1 <> 0 Then
address = address & Mid(strTextLine, x + 71, 61)
End If
j1 = j1 + 1
If check_chinese = 2 Then
c1 = c1 + 1
End If
Loop ' k<61
rs("通訊地址") = address
rs("聯絡電話") = Mid(strTextLine, 121, 16)
rs("原始發照日") = Mid(strTextLine, 137, 7)
rs("製造年月") = Mid(strTextLine, 144, 7)
'rs("車輛廠牌") = Mid(strTextLine, 151, 11)
rs("車輛種類") = Mid(strTextLine, 162, 9)
rs("引擎號碼") = Mid(strTextLine, 171, 21)
rs("排氣量") = Mid(strTextLine, 192, 5)
rs("牌照號碼") = Mid(strTextLine, 197, 7)
rs("乘載限制") = Mid(strTextLine, 204, 2)
rs("保險生效日") = Mid(strTextLine, 206, 7)
rs("保險到期日") = Mid(strTextLine, 213, 7)
rs("保費") = Mid(strTextLine, 220, 5)
rs("保險內容") = Mid(strTextLine, 225, 1)
rs.Update
rs.MoveNext
Loop While Not EOF(1)
rs.Close
conn.Close
Close #1
End Sub
非常感謝您得幫忙!!!
全站熱搜
留言列表