I've got an executable that uploads records from a SQL table to an AS400 file. It runs fine from the server when executed in the directory. However, if I try to execute it with xp_cmdshell 'filepath/file' it hangs. I wrote to a text file after each execution step and it appears to be hanging on "Set rsData = objCnn.Execute(strSQL)". I think it has something to do with the odbc connections I'm using. Does anyone have any experiece with this?
Private Sub Upload()
Dim objCnn As ADODB.Connection
Dim rsData As ADODB.Recordset
Dim strAS400cnstr, strstrSQLcnstr, strMDBcnstr, strSQL As String
On Error GoTo ErrHandler
'Create the string for AS400
strAS400cnstr = "[ODBC;DSN=WELL400;Trusted_Connection=yes;DATABASE=TAWLIB].GRIDDATES"
'Create the string for strSQL Server
strstrSQLcnstr = "[ODBC;DSN=WELLstrSQL;Trusted_Connection=yes;DATABASE=Production_Control_Data].GridDatesAS400"
'This is an unused connection but must be opened for this to work. It may be doing a passthrough?
'One of the errors said Jet Oledb couldn't find GRIDDATES. Fixed by changing the DSN to look at all libraries instead of just the default library list.
strMDBcnstr = "Provider=Microsoft.Jet.OLEDB.4.0;data source = d:\dataup\DUMMY.MDB"
Set objCnn = New ADODB.Connection
objCnn.Open strMDBcnstr ' Use it and ignore it
strSQL = "INSERT INTO "
strSQL = strSQL + strAS400cnstr + " "
strSQL = strSQL + "SELECT * "
strSQL = strSQL + "FROM " + strstrSQLcnstr + " "
objCnn.ConnectionTimeout = 15
objCnn.CommandTimeout = 15
Set rsData = objCnn.Execute(strSQL)
Exit Sub
ErrHandler:
Dim strError, ErrorMsg
strError = "VB Error Number: " & objCnn.Errors.Item(0).Number & " [0x" & Hex(objCnn.Errors.Item(0).Number) & "]" & vbCrLf
strError = strError & "Err.Description: " & objCnn.Errors.Item(0).Description & vbCrLf
strError = strError & "Err.Source: " & objCnn.Errors.Item(0).Source & vbCrLf
strError = strError & "strSQL State: " & objCnn.Errors.Item(0).strSQLState & vbCrLf & vbCrLf
MsgBox strError
strError = "Connection errors: <b>" & objCnn.Errors.Count
If (objCnn.Errors.Count > 0) Then
For Each ErrorMsg In objCnn.Errors
MsgBox (ErrorMsg.Description)
Next
End If
End Sub
Private Sub Upload()
Dim objCnn As ADODB.Connection
Dim rsData As ADODB.Recordset
Dim strAS400cnstr, strstrSQLcnstr, strMDBcnstr, strSQL As String
On Error GoTo ErrHandler
'Create the string for AS400
strAS400cnstr = "[ODBC;DSN=WELL400;Trusted_Connection=yes;DATABASE=TAWLIB].GRIDDATES"
'Create the string for strSQL Server
strstrSQLcnstr = "[ODBC;DSN=WELLstrSQL;Trusted_Connection=yes;DATABASE=Production_Control_Data].GridDatesAS400"
'This is an unused connection but must be opened for this to work. It may be doing a passthrough?
'One of the errors said Jet Oledb couldn't find GRIDDATES. Fixed by changing the DSN to look at all libraries instead of just the default library list.
strMDBcnstr = "Provider=Microsoft.Jet.OLEDB.4.0;data source = d:\dataup\DUMMY.MDB"
Set objCnn = New ADODB.Connection
objCnn.Open strMDBcnstr ' Use it and ignore it
strSQL = "INSERT INTO "
strSQL = strSQL + strAS400cnstr + " "
strSQL = strSQL + "SELECT * "
strSQL = strSQL + "FROM " + strstrSQLcnstr + " "
objCnn.ConnectionTimeout = 15
objCnn.CommandTimeout = 15
Set rsData = objCnn.Execute(strSQL)
Exit Sub
ErrHandler:
Dim strError, ErrorMsg
strError = "VB Error Number: " & objCnn.Errors.Item(0).Number & " [0x" & Hex(objCnn.Errors.Item(0).Number) & "]" & vbCrLf
strError = strError & "Err.Description: " & objCnn.Errors.Item(0).Description & vbCrLf
strError = strError & "Err.Source: " & objCnn.Errors.Item(0).Source & vbCrLf
strError = strError & "strSQL State: " & objCnn.Errors.Item(0).strSQLState & vbCrLf & vbCrLf
MsgBox strError
strError = "Connection errors: <b>" & objCnn.Errors.Count
If (objCnn.Errors.Count > 0) Then
For Each ErrorMsg In objCnn.Errors
MsgBox (ErrorMsg.Description)
Next
End If
End Sub