代碼如下；
Private Sub CommandButton1_Click()
On Error GoTo err
Dim Cur_connect As New ADODB.Connection
Dim Cur_cmd As New ADODB.Command
Dim Cur_record As New ADODB.Recordset
Dim Star_col As Integer
Dim Star_row As Integer
Dim Cur_row As Integer
Dim Cur_Col As Integer
Dim Cur_count As Integer
Dim Cur_str As String
Dim Pre_cell, Cur_cell As String
If MsgBox("確定要上傳作業日志?", vbOKCancel, "確認提示") = vbCancel Then
Exit Sub
End If
ActiveSheet.Cells.Font.ColorIndex = 0
Cur_connect.ConnectionString = ThisWorkbook.ConnectionString
Cur_connect.Open
Cur_cmd.ActiveConnection = Cur_connect
Cur_record.ActiveConnection = Cur_connect
'Cur_record.Open "select * from PG_AREA where pA_INPUTNO='" & Sheet2.Cells(1, 2) & "'"
'If Not Cur_record.EOF Then
' Cur_record.Close
' Set Cur_record = Nothing
' Set Cur_cmd = Nothing
' Cur_connect.Close
' Set Cur_connect = Nothing
' Exit Sub
'End If
Star_col = 2
Star_row = 3
Cur_count = 0
Cur_connect.BeginTrans
While Not (Cells(Star_row, Star_col) = "")
Pre_cell = Cells(Star_row - 1, Star_col + 1)
Cur_cell = Cells(Star_row, Star_col + 1)
If Cur_cell <> Pre_cell Then
' Cur_record.Open "select * from PG_AREA where pa_code='" & Sheet1.Cells(Star_row, Star_col) & "'"
' If Cur_record.EOF Then
Cur_str = "insert into ceshi.gzrz(XM,GW,SB,SM,DJSC,XX,QT,SCRQ,GZJY) values('" & Cells(Star_row, Star_col) & "','" & Cells(Star_row, Star_col + 1) & "','" & Cells(Star_row, Star_col + 2) & "','" & Cells(Star_row, Star_col + 3) & "','" & Cells(Star_row, Star_col + 4) & "','" & Cells(Star_row, Star_col + 5) & "','" & Cells(Star_row, Star_col + 6) & "','" & Cells(Star_row, Star_col + 7) & "','" & Cells(Star_row, Star_col + 8) & "')"
Cur_cmd.CommandText = Cur_str
Cur_cmd.Execute
Cur_count = Cur_count + 1
' End If
' Cur_record.Close
End If
Star_row = Star_row + 1
Wend
Cur_connect.CommitTrans
MsgBox ("作業日志上傳(" & Cur_count & "條)完成")
Cur_connect.Close
Set Cur_connect = Nothing
Exit Sub
err:
MsgBox "匯入資料出現例外：" & err.Description
Rows(Star_row).Font.ColorIndex = 3
Cur_connect.RollbackTrans
Cur_connect.Close
Set Cur_connect = Nothing
End Sub
ThisWorkbook代碼如下
Public ConnectionString As String
Private Sub Workbook_Open()
ConnectionString = "Provider=MSDAORA.1;Password=tg123456;User ID=gtfg;Data Source=fg8;Persist Security Info=True"
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
ConnectionString = "Provider=MSDAORA.1;Password=ceshi;User ID=ceshi;Data Source=ceshi;Persist Security Info=True"
End Sub
uj5u.com熱心網友回復：
連不上的原因，一般都是 ConnectionString 的問題，你可以用 ADO Data 控制元件試著連接一下，然后使用它生成的連接串來設定你自己的 ConnectionString。（我一般都這么搞）uj5u.com熱心網友回復：
可以具體一點嗎？
uj5u.com熱心網友回復：
試試這一串：Provider=MSDAORA.1;Password=tg123456;User ID=gtfg;Data Source=fg8;Persist Security Info=False
uj5u.com熱心網友回復：
換了還是不行，查了好久都沒有查出是什么原因，第一次執行的時候是正常的，但是第二次執行就開始報錯了
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/129711.html
標籤：VBA