query 2 dbf files with vba

C

Confused@424

I'm having trouble querying 2 different tables(dbf files) that are
located in two separate areas. One file would be located on a users
machine while the other would be located on the network. Does any one
have any options. I will attach what I have done so far.

If I leave the dbf files on the same drive it works fine.

Thank you for any help in advance.

Public Sub GETDATA()

On Error GoTo errhandler

Dim cnn As New ADODB.Connection
Dim cnn1 As New ADODB.Connection
Dim cmd As New ADODB.Command

Dim rst As New ADODB.Recordset
Dim strSQL As String
Dim intI As Integer

strSQL = "Select * " & _
"From Strdatalt, tempitem " & _
" Where cnn.strdatalt.st3 = cnn1.tempitem.str"

cnn.ConnectionString = "Driver={Microsoft Visual FoxPro
Driver};UID=;PWD=;" _
& "SourceDB=c:\strdatalt.dbf
;SourceType=DBF;Exclusive=No;BackgroundFetch=Yes;" _ &
"Collate=Machine;Null=Yes;Deleted=Yes;"

cnn1.ConnectionString = "Driver={Microsoft Visual FoxPro
Driver};UID=;PWD=;" _
& "SourceDB=d:\tempitem.dbf
;SourceType=DBF;Exclusive=No;BackgroundFetch=Yes;" _
& "Collate=Machine;Null=Yes;Deleted=Yes;"




cnn.Open
cnn1.Open

rst.Open strSQL, cnn, cnn1



With rst
If .RecordCount Then
intI = 6
Do Until .EOF
Application.ActiveSheet.Cells(intI, 2) = !Dpt
Application.ActiveSheet.Cells(intI, 3) = !dptnam
Application.ActiveSheet.Cells(intI, 4) = !Date
Application.ActiveSheet.Cells(intI, 5) = !cls
Application.ActiveSheet.Cells(intI, 6) = !clsnam
Application.ActiveSheet.Cells(intI, 7) = !Str
Application.ActiveSheet.Cells(intI, 8) = !w_cum
Application.ActiveSheet.Cells(intI, 9) = !M_cum
Application.ActiveSheet.Cells(intI, 10) = !D_W_Tydol
Application.ActiveSheet.Cells(intI, 11) = !D_W_PCH
Application.ActiveSheet.Cells(intI, 12) = !D_W_ST
Application.ActiveSheet.Cells(intI, 13) = !D_W_DP
Application.ActiveSheet.Cells(intI, 14) = !MTY_SLS
Application.ActiveSheet.Cells(intI, 15) = !MP_CHG
Application.ActiveSheet.Cells(intI, 16) = !MST
Application.ActiveSheet.Cells(intI, 17) = !MDP
Application.ActiveSheet.Cells(intI, 18) = !MSLS
Application.ActiveSheet.Cells(intI, 19) = !SSLS
Application.ActiveSheet.Cells(intI, 20) = !P_CHGWK
Application.ActiveSheet.Cells(intI, 21) = !WST
Application.ActiveSheet.Cells(intI, 22) = !WP_DP
Application.ActiveSheet.Cells(intI, 23) = !M_PCHG
Application.ActiveSheet.Cells(intI, 24) = !M_DP
Application.ActiveSheet.Cells(intI, 25) = !M_ST
Application.ActiveSheet.Cells(intI, 26) = !DIV
.MoveNext
intI = intI + 1
Loop
End If
.Close
End With

cnn.Close
Set cnn = Nothing
Set rst = Nothing

AddMnuDXR

Exit Sub

errhandler:
MsgBox Err.Description
If rst.State = 1 Then rst.Close
If cnn.State = 1 Then cnn.Close
Set cnn = Nothing
Set cmd = Nothing
Set rst = Nothing
Exit Sub

End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top