Automate table import with a twist...

[MatsHulten]

Can someone help me out with this one?

I need to automate an import to an Access DB from another system.
Problem is that the other system has a native loginbox that appears whenever I try to access data from it.

Any thoughts how to get around this?

-Mats

 

[timgill]

Can you/Are you using an ODBC connection for the import? If so, you may be able to adapt a bit of code I created to do just what you are talking about. It imbeds the password into the TransferDatabase method. Here it is and good luck!
Just replace the xxx's with the appropriate strings.


Dim intListCount As Integer 'Counter
Dim varTableList As Variant 'List of tables to import
Dim i As Integer 'Counter
varTableList="Activity,Batch,Comp_Demographics,
Comp_Legacy_Data,Country_Names,Degrees,Directory_Options"

intListCount = CountCSVWords(varTableList)

For i = 1 To intListCount
DoCmd.TransferDatabase acImport, "ODBC Database", "ODBC;DSN=XXXXXX DEMO;UID=XXXXXX;PWD=XXXXXX",
acTable, GetCSVWord(varTableList, i), "dbo_" & GetCSVWord
(varTableList, i), False
Next i


This also uses the following Functions (GetCSVWord, CountCSVWords):

Function CountCSVWords(S) As Integer
'
' Counts words in a string separated by commas
'
Dim WC As Integer, Pos As Integer
If VarType(S) <> 8 Or Len(S) = 0 Then
CountCSVWords = 0
Exit Function
End If
WC = 1
Pos = InStr(S, &quot;,&quot
Do While Pos > 0
WC = WC + 1
Pos = InStr(Pos + 1, S, &quot;,&quot
Loop
CountCSVWords = WC
End Function

Function GetCSVWord(S, Indx As Integer)
Dim WC As Integer, Count As Integer, SPos As Integer, EPos As Integer
WC = CountCSVWords(S)
If Indx < 1 Or Indx > WC Then
GetCSVWord = Null
Exit Function
End If
Count = 1
SPos = 1
For Count = 2 To Indx
SPos = InStr(SPos, S, &quot;,&quot + 1
Next Count
EPos = InStr(SPos, S, &quot;,&quot - 1
If EPos <= 0 Then EPos = Len(S)
GetCSVWord = Mid(S, SPos, EPos - SPos + 1)
End Function