* * *
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 "Put" command is used to write data to a file. The use of user-defined data types is illustrated. In the previous version, "Extract-Data-Write-Version," the "Write" command was used to save the user-defined data records to the file. However, this turned out to be very cumbersome. I found that using the "Put" command was a much better way of saving user-defined data records to a file.
The "Extract-Data-Write-Version" also contained bookmarks which turned out to be of no real use, so that they have been removed altogether in this "Put" version. In this version the end of the document is reached when no more transaction data are found.
* * *
Attribute VB_Name = "Extract_Data_Put_Version"
Type Electronic_transaction
Transaction_number As Integer
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
'
' This is a new version (Extract_data_2) that uses the "PUT"
' function to store data in the target file. The first version
' (Extract_data_1) used the "Write" function.
'
'
' 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 Test_Record As Electronic_transaction
Dim Transaction_amount As Currency
Dim Transaction_liters As Single
Dim Temp_Transaction_Amount As Currency
' Test vars
Dim Sort_code_test_var As String
Dim Liters_test_var As Single
Dim Amount_test_var As Currency
'
' Init Vars
'
'
Transaction_number = 0
Month_total_amount = 0
Month_total_liters = 0
Transaction_found = False
Transaction_amount = 0
Transaction_liters = 0
Temp_Transaction_Amount = 0
Transaction_found = True ' to activate first loop
'
'
' 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 Random As #1
'
' Go to beginning of document
'
Selection.HomeKey Unit:=wdStory
'
' While a transaction found in document
'
'
While Transaction_found = True
'
' Reset Transaction found flag
'
Transaction_found = False
'
'
' Search for next transaction (i.e. "SAEULENNR.")
' "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:=4
Selection.MoveRight Unit:=wdCharacter, Count:=3, Extend:=wdExtend
Marking = Selection.Text
'
' Undo marking in document - ready for next search function
'
Selection.HomeKey Unit:=wdLine
If Marking <> "BAR" Then
' Yes, electronic transaction
'
' Increment transaction no.
'
'
Transaction_number = Transaction_number + 1
'
' Store transaction no. in Electronic transaction record
' "Electronic transaction no. x"
'
Electronic_Transaction_Record.Transaction_number = Transaction_number
'Put #1, Transaction_number, Electronic_Transaction_Record
' Write #1, "Electronic transaction-number:", Transaction_number
'
' 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
'
' Store all data for current electronic transaction
'
Put #1, Transaction_number, Electronic_Transaction_Record
'
' Check that data written correctly to target file
'
Get #1, Transaction_number, Test_Record
Sort_code_test_var = Test_Record.Account_number_Sort_code
Liters_test_var = Test_Record.Transaction_liters
Amount_test_var = Test_Record.Transaction_amount
Else ' ** Cash transaction **
'
' Handle cash transaction
'
'
' Increment transaction number
'
Transaction_number = Transaction_number + 1
'
' Add transaction liters to month liters
'
Month_total_liters = Month_total_liters + Transaction_liters
'
' Add transaction amount to month amount
'
Month_total_amount = Month_total_amount + Transaction_amount
'
' Update month variables
'
End If ' ** Electronic transaction? **
End If ' ** Transaction found loop **
Wend ' ** End of Transaction found? loop ***
'
' ** No transaction found **
'
'
' Close current source document
' @
'
' Open next source document
'
T = x
' 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 Makro2()
Attribute Makro2.VB_Description = "Makro aufgezeichnet am 23.03.06 von Forrestal"
Attribute Makro2.VB_ProcData.VB_Invoke_Func = "Normal.NewMacros.Makro2"
'
' Makro2 Makro
' Makro aufgezeichnet am 23.03.06 von Forrestal
'
ActiveDocument.Close
Documents.Open FileName:="C1030701_Electr_First.log", ConfirmConversions:= _
False, ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _
PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
WritePasswordTemplate:="", Format:=wdOpenFormatAuto
Documents.Item
einDok
Documents.Open
Application.FileSearch.FoundFiles
End Sub
Back to Visual Basic Tutorial:
Like some details on the programmer?