This is a sample code that reads a file (text, dat any ASCII), then export to Excel format spreadsheet accroding to some filtering.
Attribute VB_Name = "Module1"
Sub ExtractName()
'Establish database connection
Dim Conn As New ADODB.Connection
Dim Rs As New ADODB.Recordset
Conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=eC_recipient.mdb"
Conn.Open
With Rs
.CursorType = adOpenStatic
.CursorLocation = adUseServer
.LockType = adLockReadOnly
.ActiveConnection = Conn
.Open "SELECT * FROM eC_recipient", , , , adCmdText
End With
'Initialize workbook variable
Dim SourceCol As Range
Dim ScolCount, colCounter As Long
On Error Resume Next
'Preparing a new worksheet for data dumping
Application.DisplayAlerts = False
ActiveWorkbook.Worksheets("Results").Delete
Application.DisplayAlerts = True
DeleteWorksheet = Not CBool(Err.Number)
'Count total numbers of worksheet
Dim i, count As Integer
Dim lastname As String
For i = 1 To ActiveWorkbook.Worksheets.count
count = count + 1
Next
lastname = ActiveWorkbook.Worksheets.Item(count).Name
' MsgBox CStr(count)
Dim wksNewSheet As Excel.Worksheet
Set wksNewSheet = Worksheets.Add
'Name and allocate the new worksheet
With wksNewSheet
.Name = "Results"
.Move After:=Worksheets(lastname)
End With
'Make a count of how many cells have to process
Worksheets(1).Activate
Set SourceCol = Columns("A")
For colCounter = 1 To SourceCol.Rows.count
ScolCount = ScolCount + 1
Next
' MsgBox CStr(ScolCount)
'Start processing
Dim tempC, tempStr As String
For i = 1 To ScolCount
Set curcell = Worksheets("Results").Cells(i, 1)
Set curcell2 = Worksheets("Results").Cells(i, 2)
If SourceCol.Cells(i).Value <> "" Then
tempC = UCase(Replace(SourceCol.Cells(i).Value,
Mid(SourceCol.Cells(i).Value, 1, 33), ""))
Rs.MoveFirst
Do While Not Rs.EOF
tempStr = UCase(Replace(Rs.Fields(0).Value,
Mid(Rs.Fields(0).Value, 1, 6), ""))
If tempC = tempStr Then
curcell.Value
= tempC
curcell2.Value
= Rs.Fields(1).Value
GoTo Exit_Loop
End If
Rs.MoveNext
Loop
curcell.Value = tempC
curcell2.Value = "Unknown"
End If
Exit_Loop:
Next
If Err.Number <> 0 Then
MsgBox Err.Number + " " + Err.Description + " " + Err.Source
End If
MsgBox CStr(ScolCount) + " records completed!", vbInformation + vbOKOnly,
"Completed!"
Worksheets("Results").Activate
Columns("A:A").EntireColumn.AutoFit
Columns("B:B").EntireColumn.AutoFit
End Sub
Comments