December 2, 2009
The following Excel macro shows how to open a text file as a database using ADO, create a table in Oracle, and then transfer the rows from the text file into the database table using bind variables. Once the transfer finishes, a worksheet in Excel is populated with the data from the Oracle table.
Private Sub TransferRows()
'Need to add a reference to Microsoft ActiveX Data Objects 2.8 Library before starting
Dim i As Integer
Dim intResult As Integer
Dim strSQL As String
Dim strTable As String
Dim strDBTable As String
Dim snpData As ADODB.Recordset
Dim comDataInsert As ADODB.Command
On Error Resume Next
strTable = Sheets("ExcelQueryofTextFile").Cells(1, 2).Value
strTable = Right(strTable, Len(strTable) - InStrRev(strTable, "\"))
'Set the database table name to the file name without the extension
strDBTable = UCase(Left(strTable, InStr(strTable, ".") - 1))
Sheets("ExcelQueryofTextFile").Range("A5:M10006").Delete Shift:=xlUp
Set snpData = New ADODB.Recordset
strSQL = "SELECT" & vbCrLf
strSQL = strSQL & " [Source IP Address]," & vbCrLf
strSQL = strSQL & " [Destination IP Address]," & vbCrLf
strSQL = strSQL & " [Time]," & vbCrLf
strSQL = strSQL & " [Source Port]," & vbCrLf
strSQL = strSQL & " [Destination Port]," & vbCrLf
strSQL = strSQL & " [L3 Protocol]," & vbCrLf
strSQL = strSQL & " [Application Path]," & vbCrLf
strSQL = strSQL & " [Application Description]," & vbCrLf
strSQL = strSQL & " [Rule Description]" & vbCrLf
strSQL = strSQL & "FROM" & vbCrLf
strSQL = strSQL & " [" & strTable & "]" & vbCrLf
strSQL = strSQL & "ORDER BY" & vbCrLf
strSQL = strSQL & " [Source IP Address]," & vbCrLf
strSQL = strSQL & " [Time]"
snpData.Open strSQL, dbFile
If snpData.State = 1 Then
strSQL = "CREATE TABLE " & strDBTable & "(" & vbCrLf
strSQL = strSQL & " SOURCE_IP VARCHAR2(16)," & vbCrLf
strSQL = strSQL & " DESTINATION_IP VARCHAR2(16)," & vbCrLf
strSQL = strSQL & " ACCESS_TIME DATE," & vbCrLf
strSQL = strSQL & " SOURCE_PORT NUMBER(12)," & vbCrLf
strSQL = strSQL & " DESTINATION_PORT NUMBER(12)," & vbCrLf
strSQL = strSQL & " PROTOCOL VARCHAR2(15)," & vbCrLf
strSQL = strSQL & " APPLICATION_PATH VARCHAR2(100)," & vbCrLf
strSQL = strSQL & " APPLICATION_DESCRIPTION VARCHAR2(100)," & vbCrLf
strSQL = strSQL & " RULE_DESCRIPTION VARCHAR2(30))" & vbCrLf
dbVMFG.Execute strSQL
Set comDataInsert = New ADODB.Command
With comDataInsert
strSQL = "INSERT INTO " & strDBTable & "(" & vbCrLf
strSQL = strSQL & " SOURCE_IP," & vbCrLf
strSQL = strSQL & " DESTINATION_IP," & vbCrLf
strSQL = strSQL & " ACCESS_TIME," & vbCrLf
strSQL = strSQL & " SOURCE_PORT," & vbCrLf
strSQL = strSQL & " DESTINATION_PORT," & vbCrLf
strSQL = strSQL & " PROTOCOL," & vbCrLf
strSQL = strSQL & " APPLICATION_PATH," & vbCrLf
strSQL = strSQL & " APPLICATION_DESCRIPTION," & vbCrLf
strSQL = strSQL & " RULE_DESCRIPTION)" & vbCrLf
strSQL = strSQL & "VALUES(" & vbCrLf
strSQL = strSQL & " ?," & vbCrLf
strSQL = strSQL & " ?," & vbCrLf
strSQL = strSQL & " ?," & vbCrLf
strSQL = strSQL & " ?," & vbCrLf
strSQL = strSQL & " ?," & vbCrLf
strSQL = strSQL & " ?," & vbCrLf
strSQL = strSQL & " ?," & vbCrLf
strSQL = strSQL & " ?," & vbCrLf
strSQL = strSQL & " ?)" & vbCrLf
.Parameters.Append .CreateParameter("source_ip", adVarChar, adParamInput, 16)
.Parameters.Append .CreateParameter("destination_ip", adVarChar, adParamInput, 16)
.Parameters.Append .CreateParameter("access_time", adDate, adParamInput, 8 )
.Parameters.Append .CreateParameter("source_port", adNumeric, adParamInput, 8 )
.Parameters.Append .CreateParameter("destination_port", adNumeric, adParamInput, 8 )
.Parameters.Append .CreateParameter("protocol", adVarChar, adParamInput, 15)
.Parameters.Append .CreateParameter("application_path", adVarChar, adParamInput, 100)
.Parameters.Append .CreateParameter("application_description", adVarChar, adParamInput, 100)
.Parameters.Append .CreateParameter("rule_description", adVarChar, adParamInput, 30)
'Set up the command properties
.CommandText = strSQL
.CommandType = adCmdText
.CommandTimeout = 30
.ActiveConnection = dbVMFG
End With
If Err = 0 Then
dbVMFG.BeginTrans
Do While Not snpData.EOF
comDataInsert("source_ip") = snpData(0).Value
comDataInsert("destination_ip") = snpData(1).Value
comDataInsert("access_time") = CDate(snpData(2).Value)
comDataInsert("source_port") = Val(snpData(3).Value)
comDataInsert("destination_port") = Val(snpData(4).Value)
comDataInsert("protocol") = Left(snpData(5).Value, 15)
comDataInsert("application_path") = Left(snpData(6).Value, 100)
comDataInsert("application_description") = Left(snpData(7).Value, 100)
comDataInsert("rule_description") = Left(snpData(8).Value, 30)
comDataInsert.Execute
snpData.MoveNext
Loop
snpData.Close
If Err = 0 Then
dbVMFG.CommitTrans
Else
dbVMFG.RollbackTrans
End If
strSQL = "SELECT" & vbCrLf
strSQL = strSQL & " SOURCE_IP," & vbCrLf
strSQL = strSQL & " DESTINATION_IP," & vbCrLf
strSQL = strSQL & " ACCESS_TIME," & vbCrLf
strSQL = strSQL & " SOURCE_PORT," & vbCrLf
strSQL = strSQL & " DESTINATION_PORT," & vbCrLf
strSQL = strSQL & " PROTOCOL," & vbCrLf
strSQL = strSQL & " APPLICATION_PATH," & vbCrLf
strSQL = strSQL & " APPLICATION_DESCRIPTION," & vbCrLf
strSQL = strSQL & " RULE_DESCRIPTION" & vbCrLf
strSQL = strSQL & "FROM" & vbCrLf
strSQL = strSQL & " " & strDBTable & vbCrLf
strSQL = strSQL & "ORDER BY" & vbCrLf
strSQL = strSQL & " SOURCE_IP," & vbCrLf
strSQL = strSQL & " ACCESS_TIME"
snpData.Open strSQL, dbVMFG
If snpData.State = 1 Then
'The fast way to place the query results into cells
For i = 0 To snpData.Fields.Count - 1
Sheets("ExcelQueryofTextFile").Cells(5, i + 1).Value = snpData.Fields(i).Name
Next i
Sheets("ExcelQueryofTextFile").Range(Sheets("ExcelQueryofTextFile").Cells(5, 1), Sheets("ExcelQueryofTextFile").Cells(5, snpData.Fields.Count)).Font.Bold = True
Sheets("ExcelQueryofTextFile").Range("A6").CopyFromRecordset snpData
snpData.Close
End If
Else
intResult = MsgBox("Could not create the table " & strDBTable & " in the database." & vbCrLf & Error(Err), 16, "Excel Demo")
End If
End If
Sheets("ExcelQueryofTextFile").Range("A6").Select
ActiveWindow.FreezePanes = True
Set snpData = Nothing
Set comDataInsert = Nothing
End Sub

Recent Comments