As soon as you click on connect the to section Export Tables is enabled. If you select Sql from Export data for combo then right section will be enabled for custom sql. If you select Tables then list of tables for the user schema will be populated on the Combo. You can either select a single table or if you do not select any table then all tables will be exported when you click on Export, but if you select one table then that particular table will be exported.
This is the interface from where data will be exported. The project is uploaded in google drive and code is provided in tis article.
Download the Code from - Google Drive
Option Explicit
Private con As Object
Private rs As Object
Private rs1 As Object
Private table_name As String, fieldName As String, _
recordString As String, fieldValue As String
Private Sub cmdExportType_Click()
If cmdExportType.Text = "Tables" Then
customExportFrame.Enabled = False
If cmbTableList.ListCount = 0 Then
Call populateListofTables
End If
cmbTableList.Enabled = True
Else
customExportFrame.Enabled = True
cmbTableList.Enabled = False
End If
End Sub
Private Sub Command1_Click()
If cmdExportType.Text = "Tables" Then
Call getListofTablesAndData
Else
Call GetSqlData
End If
End Sub
Private Sub cmdConnect_Click()
Call OpenConnection(txtUser.Text, txtPasswd.Text, txtHostName.Text)
tableListFrame.Enabled = True
End Sub
Private Sub Form_Load()
cmdExportType.Clear
cmdExportType.AddItem "Tables"
cmdExportType.AddItem "Sql"
tableListFrame.Enabled = False
customExportFrame.Enabled = False
End Sub
Private Sub populateListofTables()
Set rs1 = CreateObject("ADODB.Recordset")
rs1.Open "select table_name from cat where table_type = 'TABLE' order by table_name", con
cmbTableList.Clear
While Not rs1.EOF
cmbTableList.AddItem VBA.IIf(IsNull(rs1(0)), "", rs1(0))
rs1.MoveNext
DoEvents
Wend
rs1.Close
Set rs1 = Nothing
End Sub
Private Sub getListofTablesAndData()
Call GenerateTableData(cmbTableList.Text)
End Sub
Private Sub GetSqlData()
Dim SqlStr As String, fieldString As String
Dim rs1 As Object
Dim i As Integer
SqlStr = txtSql.Text
Set rs1 = CreateObject("ADODB.RecordSet")
rs1.Open SqlStr, con, 2
Open App.Path & "\csv_data\" & tblName.Text & ".csv" For Output As #1
fieldString = ""
For i = 0 To rs1.Fields.Count - 1
fieldString = fieldString & rs1(i).Name & ","
DoEvents
Next i
fieldString = VBA.Left(fieldString, VBA.Len(fieldString) - 1)
Print #1, fieldString
recordString = ""
PBRecords.Value = 0
If rs1.RecordCount > 0 Then
PBRecords.Max = rs1.RecordCount
While Not rs1.EOF
recordString = ""
For i = 0 To rs1.Fields.Count - 1
fieldValue = VBA.IIf(IsNull(rs1(i)), "", rs1(i))
fieldValue = VBA.Replace(fieldValue, ",", " ")
recordString = recordString & fieldValue & ","
DoEvents
Next i
recordString = VBA.Left$(recordString, VBA.Len(recordString) - 1)
Print #1, recordString
DoEvents
rs1.MoveNext
PBRecords.Value = PBRecords.Value + 1
lblRecords.Caption = Round((PBRecords.Value / PBRecords.Max) * 100, 2) & "%"
Wend
End If
Close #1
rs1.Close
End Sub
Private Sub OpenConnection(user As String, pass As String, serviceName As String)
On Error GoTo OpenConnection_Error
If con Is Nothing Then
Set con = CreateObject("ADODB.Connection")
con.CursorLocation = adUseClient
con.ConnectionString = "Provider=MSDAORA.1;User ID=" & user & ";Password=" & pass & ";Data Source=" & serviceName & ";Persist Security Info=False"
con.Open
End If
On Error GoTo 0
Exit Sub
OpenConnection_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure OpenConnection of Form Form1"
End Sub
Private Sub OpenConnections(userName As String, passwd As String, dataSource As String)
If con Is Nothing Then
Set con = CreateObject("ADODB.Connection")
con.CursorLocation = adUseClient
con.ConnectionString = "Provider=MSDAORA.1;User ID=" & userName & ";Password=" & passwd & _
";Data Source=" & dataSource & ";Persist Security Info=False"
con.Open
End If
End Sub
Private Sub GenerateTableData(Optional singleTable As String)
Dim i As Integer
If rs Is Nothing Then
Set rs = CreateObject("ADODB.Recordset")
Set rs1 = CreateObject("ADODB.Recordset")
rs.Open "select * from cat where table_type = 'TABLE'" & VBA.IIf(singleTable <> "", _
" and table_name = '" & singleTable & "'", ""), con
PBTables.Value = 0
PBTables.Max = rs.RecordCount
While Not rs.EOF
table_name = VBA.IIf(IsNull(rs(0)), "", rs(0))
Form1.Caption = "Exporting data for " & table_name & " table "
If VBA.Trim$(table_name) <> "" Then
Open App.Path & "\csv_data\" & table_name & ".csv" For Output As #1
rs1.Open "select * from " & table_name, con, 1
fieldName = ""
For i = 0 To rs1.Fields.Count - 1
fieldName = fieldName & rs1(i).Name & ","
DoEvents
Next i
fieldName = VBA.Left$(fieldName, VBA.Len(fieldName) - 1)
Print #1, fieldName
PBRecords.Value = 0
If rs1.RecordCount > 0 Then
PBRecords.Max = rs1.RecordCount
While Not rs1.EOF
recordString = ""
For i = 0 To rs1.Fields.Count - 1
' On Error Resume Next
fieldValue = getValue(rs1, i, table_name, PBTables.Value + 1)
fieldValue = VBA.Replace(fieldValue, ",", " ")
recordString = recordString & fieldValue & ","
DoEvents
Next i
recordString = VBA.Left$(recordString, VBA.Len(recordString) - 1)
Print #1, recordString
DoEvents
rs1.MoveNext
PBRecords.Value = PBRecords.Value + 1
lblRecords.Caption = Round((PBRecords.Value / PBRecords.Max) * 100, 2) & "%"
lblRecords.Refresh
Wend
PBTables.Value = PBTables.Value + 1
lblTables.Caption = Round((PBTables.Value / PBTables.Max) * 100, 2) & "%"
lblTables.Refresh
End If
Close #1
rs1.Close
End If
DoEvents
rs.MoveNext
Wend
Set rs = Nothing
Set rs1 = Nothing
End If
End Sub
Private Function getValue(r As Object, ByVal idx As Long, ByVal tbl_name As String, recNo As Long) As String
On Error GoTo Err1
getValue = VBA.IIf(IsNull(r(idx).Value), "", r(idx).Value)
Exit Function
Err1:
Open App.Path & "\errLog.log" For Append As #2
Print #2, "Error on " & tbl_name & " table on column " & VBA.IIf(IsNull(r(idx).Name), "", r(idx).Name) & ", index " & idx & " on record number " & recNo & " whose column " & VBA.IIf(IsNull(r(0).Name), "", r(0).Name) & " value is " & VBA.IIf(IsNull(r(0).Value), "", r(0).Value)
Close #2
End Function
Private Sub GetLatLongData()
Call OpenConnections("bckv", "bckv", "ORCL")
Open App.Path & "\lat_long.csv" For Input As #1
Dim newLine As String
Dim var
Line Input #1, newLine
While Not EOF(1)
Line Input #1, newLine
var = VBA.Split(newLine, ",")
Call con.Execute("insert into citieslatlong (City,ProvinceState,Country,Latitude,Longitude) " & _
"values('" & VBA.Replace(var(0), "'", "''") & "','" & VBA.Replace(var(1), "'", "''") & "','" & VBA.Replace(var(2), "'", "''") & "','" & VBA.Replace(var(3), "'", "''") & "','" & VBA.Replace(var(4), "'", "''") & "')")
Wend
Close #1
End Sub
Private Sub txtHostName_Change()
cmdConnect.Enabled = (txtUser.Text <> "" And txtPasswd.Text <> "" And txtHostName.Text <> "")
End Sub
Private Sub txtPasswd_Change()
cmdConnect.Enabled = (txtUser.Text <> "" And txtPasswd.Text <> "" And txtHostName.Text <> "")
End Sub
Private Sub txtUser_Change()
cmdConnect.Enabled = (txtUser.Text <> "" And txtPasswd.Text <> "" And txtHostName.Text <> "")
End Sub
No comments:
Post a Comment