Transfer Database - Import tables fom Oracle

K

kfschaefer

Ihave written code to transfer database tables from Oracle, however, when I
use the converted code from a macro - it requires a pop for login info.

I need to eliminate this popup and have the process run automatically at
night.

here is my current code - Please feel free to make suggestions.

Yes the password and user id are identical - for ease of use - since you
can't collect the current user id and password via vba.

Private Declare Function apiGetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Function fOSUserName() As String
' Returns the network login name
Dim lngLen As Long, lngX As Long
Dim strUserName As String
strUserName = String$(254, 0)
lngLen = 255
lngX = apiGetUserName(strUserName, lngLen)
If (lngX > 0) Then
fOSUserName = Left$(strUserName, lngLen - 1)
Else
fOSUserName = vbNullString
End If
End Function
'******************** Code End **************************
'------------------------------------------------------------
' Get_Latest_Metrica_Data_From_MTR2
' Will automatically update/replace the data weekly -
' to be run @ 3am evert Wednesday
'------------------------------------------------------------
Function Get_Latest_Metrica_Data_From_MTR2()
On Error GoTo Get_Latest_Metrica_Data_From_MTR2_Err
Dim nTable, nDev As String
Dim db As Database
Dim rs As Recordset
Dim strSql As String
Dim cn As ADODB.Connection
Dim strConnection As String
Dim i As Integer

SetWarnings = False

strSql = "SELECT Name" & _
" FROM tblListActiveImportTables"

Set db = currentdb() 'Use the current database
Set rs = db.OpenRecordset(strSql) 'actually open the recordset

i = 0

Do Until rs.EOF = True
i = i + 1
nTable = rs.Fields("Name")
nDev = Replace(Left(rs.Fields("Name"), InStr(rs.Fields("Name"), "_")),
"_", ".") & Mid(rs.Fields("Name"), InStr(rs.Fields("Name"), "_") + 1)

On Error Resume Next
If IsObject(currentdb.TableDefs(nTable)) Then
DoCmd.DeleteObject acTable, nTable
End If

strConnection = "ODBC;DSN=MTR2;UID=" & fOSUserName & ";PWD=" &
fOSUserName & ";DATABASE=MTR2"
'Create a new ADO Connection object
Set cn = New ADODB.Connection

With cn
.Provider = "MSDASQL"
.Properties("Data Source").Value = strConnection
.Open
End With
DoCmd.TransferDatabase acImport, strConnection, Table = " & Chr(34) & ndev &
Chr(34) & ", acTable, " & Chr(34) & nDev & Chr(34) & ", " & Chr(34) & nTable
& Chr(34) & """"", False

'DoCmd.TransferDatabase acImport, "ODBC Database", _
"ODBC;DSN=MTR2;UID=" & fOSUserName & ";PWD=" & fOSUserName &
";LANGUAGE=us_english;" _
& "DATABASE=MTR2", acTable, Table=" & Chr(34) & ndev & Chr(34) & "," &
Chr(34) & ndev & Chr(34) & ", " & Chr(34) & nTable & Chr(34) & "", True"

DoCmd.TransferDatabase acImport, "ODBC", "ODBC;DSN=MTR2;UID=" & fOSUserName
& ";", _
"PWD=" & fOSUserName & "; & DBQ=MTR2
;DBA=W;APA=T;EXC=F;FEN=T;QTO=T;FRC=10;", _

"FDL=10;LOB=T;RST=T;GDE=F;FRL=F;BAM=IfAllSuccessful;MTS=F;MDI=F;CSR=F;FWC=F;", _
"PFC=10;TLO=0;;TABLE=" & Chr(34) & nDev & Chr(34) & ", acTable,", _
" " & Chr(34) & nDev & Chr(34) & "," & Chr(34) & nTable & Chr(34) &
", False"
' DoCmd.TransferDatabase acImport, "ODBC",
"ODBC;DSN=MTR2;UID=JGONZALEZ;DBQ=MTR2
;DBA=W;APA=T;EXC=F;FEN=T;QTO=T;FRC=10;FDL=10;LOB=T;RST=T;GDE=F;FRL=F;BAM=IfAllSuccessful;MTS=F;MDI=F;CSR=F;FWC=F;PFC=10;TLO=0;;TABLE=APPUSER.MSCTR_DY",
acTable, "APPUSER.MSCTR_DY", "APPUSER_MSCTR_DY", False
rs.MoveNext
Loop
rs.Close

Get_Latest_Metrica_Data_From_MTR2_Exit:
Exit Function

Get_Latest_Metrica_Data_From_MTR2_Err:
MsgBox Error$

Resume Get_Latest_Metrica_Data_From_MTR2_Exit

End Function

As you can see I have many different version of transferdatabase in attempt
to prevent the popup.
 

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