Custom Search

Extract Data Write Version

* * *

Work in Progress

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.

* * *

VB Macro Code

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?