* * *
This is a live demo of the development process involved in writing a visual basic (VB) macro. The macro is still not finished at this stage. In this version of the macro the "Write" command is used to write data to a file. The use of user-defined data types is illustrated. However, using the "Write" command to save user-defined data records to a file turned out to be very cumbersome. In the next version the "Put" command will be used instead of the "Write" command.
* * *
Type Electronic_transaction
Account_number_Sort_code As String
Transaction_liters As Single
Transaction_amount As Currency
End Type
Sub Makro1()
'
' Makro1 Makro Name "Extract_Data"
' Makro aufgezeichnet am 07.12.05 von Forrestal, find "Konto" test
' Extract customer data from log file
'
' Called from first source-data document (x.log) - txt file
'
' Define data formats
'
' Type Typ1
' Name1 As String ' String-Variable für Namen.
' Geburtstag As Date ' Date-Variable für
' ' Geburtstag.
' Geschlecht As Integer ' Integer-Variable für
' ' Geschlecht
' End Type ' (0 für weiblich, 1 für männlich).
' Type Electronic_transaction
' Account_number_Sort_code As String
' Transaction_liters As Single
' Transaction_amount As Currency
' End Type
Dim Electronic_Transaction_Record As Electronic_transaction
Dim Transaction_amount As Currency
Dim Transaction_liters As Single
Dim Temp_Transaction_Amount As Currency
'
' Init Vars
'
'
Transaction_no = 0
Month_total_amount = 0
Month_total_liters = 0
Transaction_found = False
Transaction_amount = 0
Transaction_liters = 0
Temp_Transaction_Amount = 0
'
'
' Get name of current directory, e.g. "july_2003"
'
Path_and_File_name = ActiveDocument.FullName
'
' Parse out source data month file name
'
Source_Dir_and_Doc_name = Right(Path_and_File_name, 22)
Current_Directory = Left(Source_Dir_and_Doc_name, 9)
'
' Form name of target file for extracted data
'
Target_File_Name = Current_Directory + "_extracted_data"
'
' Add extracted data path name to Target file name
'
'
Target_File = "C:\Eigene Dateien\Extracted_data\" + Target_File_Name
' Open target file for Append
'
Open Target_File For Append As #1
'
' Go to beginning of document
'
Selection.HomeKey Unit:=wdStory
'
' Set "current" bookmark
'
ActiveDocument.Bookmarks.Add Name:="Current"
'
' While not end of document
'
'
While ActiveDocument.Bookmarks.Item("Current") <> "\EndOfDoc"
'
' Place cursor at current bookmark
'
ActiveDocument.Bookmarks("Current").Select
'
' Reset Transaction found flag
'
Transaction_found = False
'
'
' Search for next transaction (i.e. "SAEULENNR." - = pump no. in English)
' "SAEULENNR." is marked
'
With Selection.Find
.ClearFormatting
.Wrap = wdFindStop
.Forward = True
.Format = False
.MatchCase = True
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute FindText:="SAEULENNR.", Forward:=True
If .found = True Then
Transaction_found = True
End If
End With
'
' Transaction found?
'
If Transaction_found = True Then
'
' Yes
'
'
' Store temporarily transaction liters
'
' Get line (Sale_line) contining liters amount
'
Selection.HomeKey Unit:=wdLine
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Copy
Sale_Line = Selection.Text
'
' Extract Liters amount from line
'
'
' Find position of "BLF" in Sale_Line
'
BLF_Pos = InStr(Sale_Line, "BLF")
'
' Find position of "Liter" in Sale_Line
'
Liter_Pos = InStr(Sale_Line, "Liter")
'
' Extract Liters amount from string
'
Temp_Liters_Amount = Mid(Sale_Line, BLF_Pos + 3, Liter_Pos - BLF_Pos - 3)
'
' Trim Liters_Amount (trim leading/trailing zeros)
'
Trimmed_Liters_Amount = Trim(Temp_Liters_Amount)
'
' Store Liters amount in running total for month
'
Transaction_liters = Transaction_liters + Trimmed_Liters_Amount
'
' Store temporarily transaction amount
'
'
' Find position of "EUR" in Sale_Line
'
EUR_Pos = InStr(Sale_Line, "EUR")
Sale_Line_Length = Len(Sale_Line)
Last_Star_Pos = Sale_Line_Length - 3
'
' Extract trans amount from Sale line
'
'
Temp_Transaction_Amount = Mid(Sale_Line, EUR_Pos + 3, Last_Star_Pos - (EUR_Pos + 3))
'
' Store transaction amount in running total for month
'
'
' Store temporarily transaction amount
Transaction_amount = Transaction_amount + Temp_Transaction_Amount
'
' Electronic transaction?
'
Selection.HomeKey Unit:=wdLine
Selection.MoveDown Unit:=wdLine, Count:=5
Selection.MoveRight Unit:=wdCharacter, Count:=3, Extend:=wdExtend
Marking = Selection.Text
If Marking <> "BAR" Then
' Yes, electronic transaction
'
' Increment transaction no.
'
'
Transaction_no = Transaction_no + 1
'
' Write record no. to target file
' "Electronic transaction no. x"
'
Write #1, "Electronic transaction-number:", Transaction_no
'
' Extract/Store account no. & sort code
'
Selection.HomeKey Unit:=wdLine
Selection.Find.ClearFormatting
With Selection.Find
.Text = "Konto"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
'
' Mark account no. & sort code
'
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
'
' Store account no. & sort code in transaction record
'
Electronic_Transaction_Record.Account_number_Sort_code = Selection.Text
Write #1, Electronic_Transaction_Record.Account_number_Sort_code
'
' Store transaction liters in transaction record
'
Electronic_Transaction_Record.Transaction_liters = Transaction_liters
Write #1, Electronic_Transaction_Record.Transaction_liters
'
' Store transaction amount in transaction record
'
Electronic_Transaction_Record.Transaction_amount = Transaction_amount
Write #1, Electronic_Transaction_Record.Transaction_amount
End If ' ** Cash transaction? **
End If ' ** "Transaction found?" loop ***
' Mark Konto no. and bank code
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
' Selection.EndKey Unit:=wdLine, Extend:=wdExtend
' Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
' Save Konto line in Konto_File
Konto_Line = Selection.Text
Open "c:/Stammkunde/Konto_data/Konto_File" For Append As #1
Print #1, Konto_Line
Close #1
Exit Sub
Selection.MoveLeft Unit:=wdCharacter, Count:=2
Selection.HomeKey Unit:=wdStory, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.Find.ClearFormatting
With Selection.Find
.Text = "Konto : "
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.MoveLeft Unit:=wdCharacter, Count:=2
Wend ' End of document
End Sub
Sub Makro3()
'
' Makro3 Makro
' Makro aufgezeichnet am 20.03.06 von Forrestal
'
Selection.HomeKey Unit:=wdLine
Selection.Find.ClearFormatting
With Selection.Find
.Text = "Konto"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
End Sub
Sub Makro4()
'
' Makro4 Makro
' Makro aufgezeichnet am 21.03.06 von Forrestal
'
Selection.HomeKey Unit:=wdLine
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Copy
End Sub
Back to Visual Basic Tutorial:
Like some details on the programmer?