Custom Search

Extract Data Put 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 "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.

* * *

VB Macro Code

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?