nandeshwar.info

Dim sTblNm As String
Dim sTypExprt As String
Dim sCnxnStr As String, vStTime As Variant
Dim db As Database, tbldef As DAO.TableDef

On Error GoTo ExportTbls_Error

sTypExprt = “ODBC Database” ‘Export Type
sCnxnStr = “ODBC;DSN=DSNName;UID=userID;PWD=password” ‘Create the connection string

vStTime = Timer
Application.Echo False, “Visual Basic code is executing.”

Set db = CurrentDb()

‘need a reference to Microsoft DAO 3.x library
For Each tbldef In db.TableDefs
‘Don’t export System and temporary tables
If Left(tbldef.Name, 4) “MSys” And Left(tbldef.Name, 4) “~TMP” Then
‘Debug.Print tbldef.Name
sTblNm = tbldef.Name
DoCmd.TransferDatabase acExport, sTypExprt, sCnxnStr, acTable, sTblNm, sTblNm
End If
Next tbldef

MsgBox “Done! Time taken=” & Timer – vStTime

On Error GoTo 0
SmoothExit_ExportTbls:
Set db = Nothing
Application.Echo True
Exit Sub

ExportTbls_Error:
MsgBox “Error ” & Err.Number & ” (” & Err.Description & “) in procedure ExportTblsODST”
Resume SmoothExit_ExportTbls
End Sub

DelteTbls_Error:
    MsgBox “Error ” & Err.Number & ” (” & Err.Description & “) in procedure DelteTbls”
    Resume SmoothExit_DelteTbls
End Sub

sFileNm = Dir(sPath, vbNormal)
Do While sFileNm “”
If Right(sFileNm, 3) = “dbf” Then
sTblNm = Left(sFileNm, Len(sFileNm) – 4) ‘Extract the file name
‘Use the TransferDatabase option to link the tables from the specified directory
‘to your current Access DB
DoCmd.TransferDatabase acLink, “dBase III”, sPath, acTable, sTblNm, sTblNm
End If
sFileNm = Dir
Loop

Application.Echo True
End Sub

sPath = “C:\DW\”
‘You can also use Application.GetOpenFilename to get a file name from a folder,
‘and then extract the Directory name from that string
‘You can also use filters with GetOpenFilenam such as *.txt, see Help on this topic

sFileNm = Dir(sPath, vbNormal) ‘Get the first file from the specified directory
‘Start a loop
Do While sFileNm “”
‘If the file has a dbf extension then print the file name
If Right(sFileNm, 3) = “dbf” Then
Debug.Print sFileNm
End If
sFileNm = Dir
Loop
End Sub

Set rngRng2bCated = Application.InputBox(prompt:=”Select the range you’d like to concatenate with a charcter”, _
Title:=”Select Range”, Type:=8)

If rngRng2bCated Is Nothing Then Exit Sub

‘You could use this line to set the default to a comma and remove the inputbox line
’sChar2bAdded = “,”
sChar2bAdded = InputBox(“Enter the character you’d like to add between other cells”, “Enter Character”, “,”)

Set rngTarget = Application.InputBox(prompt:=”Select the range you’d like the output”, _
Title:=”Select Range”, Type:=8)

For Each c In rngRng2bCated
sOutput = sOutput & c.Value & sChar2bAdded
Next c

sOutput = Left(sOutput, Len(sOutput) – Len(sChar2bAdded))
rngTarget = sOutput

On Error GoTo 0
Exit Sub

ConCatwChar_Error:
MsgBox “Error ” & Err.Number & ” (” & Err.Description & “) in procedure ConCatwChar”
End Sub

On Error GoTo ConCatFunc_Error

For Each c In rngRng2bCated
sOutput = sOutput & c.Value & sChar2bAdded
Next c
sOutput = Left(sOutput, Len(sOutput) – Len(sChar2bAdded))
ConCatFunc = sOutput

On Error GoTo 0
Exit Function

ConCatFunc_Error:
ConCatFunc = “#Error#”

End Function