Extracting data from Text File

[loquito88]

I have this request, I have this txt file that has information that I need in my database. The information is always on the same spot. The filename is different every time so I would have to look for the file.

The main idea is to get these 3 text segment into my form by extracting and importing data automatically.

Thanks to anyone that my help me with this. As you could see, Im not and expert in type of situations.

 

[Ranman256]

paste the code into the form module area

put a button on the form to run: Pick1File
to pick the text file you want to load.
it will then parse the file to fill in the boxes. rename the form box names to YOUR CONTROL NAMES

Option Compare Database
Option Explicit

Public Sub Pick1File()
Dim vFile

vFile = UserPick1File()
If vFile <> "" Then
   'do somethin with file
   ImportTxtData vFile
End If

End Sub

'load data into form
Public Sub ImportTxtData(ByVal pvFile)
Dim vLine, vSerial, vBitKey, vRecover
Dim i As Integer

Close 1
Open pvFile For Input As #1

Line Input #1, vLine
While Not EOF(1)
   
   Select Case True
      Case InStr(vLine, "Serial") > 0
         i = InStr(vLine, ":")
         vSerial = Trim(Mid(vLine, i + 1))
   
      Case InStr(vLine, "Bitlocker Key") > 0
         i = InStr(vLine, ":")
         vBitKey = Trim(Mid(vLine, i + 1))
   
      Case InStr(vLine, "Bitlocker Recovery Key") > 0
           Line Input #1, vLine
           Line Input #1, vLine
         vRecover = Trim(vLine)
   End Select
   
   Line Input #1, vLine
Wend
Close 1

'fill in form boxes..rename them to YOUR CONTROL NAMES
txtMachName = vSerial
txtBitlocker = vBitKey
txtvRecover = vRecover

End Sub



Public Function UserPick1File(Optional pvPath)
Dim strTable As String
Dim strFilePath As String
Dim sDialogMsg As String, sDecr  As String, sExt As String
Const msoFileDialogViewList = 1
Const msoFileDialogSaveAs = 2
Const msoFileDialogFilePicker = 3
Dim lFilterIndex As Long

'getFilterTxt pvFilter, sDecr, sExt, sDialog
If IsMissing(pvPath) Then pvPath = "c:\"

''SetFileFilter pvFilter, sDecr, sExt, sDialogMsg

'Application.FileDialog(msoFileDialogSaveAs) =2     'SAVE AS
'Application.FileDialog(msoFileDialogFilePicker) =3  'file OPEN

With Application.FileDialog(3)   'REFERENCE not needed now : Microsoft Office XX.0 Object Library
    .AllowMultiSelect = True
    .Title = sDialogMsg   ' "Locate a file to Import"
    .ButtonName = "Import"
    .Filters.Clear
    '.Filters.Add sDecr, sExt
        '.Filters.Add "Access Files", "*.accdb;*.mdb"
        '.Filters.Add "Excel Files", "*.xlsx"
    '.Filters.Add "_All Files", "*.*"
    .Filters.Add "Text Files", "*.txt"
    
      For lFilterIndex = 1 To .Filters.Count
        'Debug.Print lFilterIndex, .Filters(lFilterIndex).Description
        
              'get pdf format from type filter
           If InStr(.Filters(lFilterIndex).Description, "PDF") > 0 Then
               .FilterIndex = lFilterIndex
               Exit For
           End If
       Next
    
    .InitialFileName = pvPath
    .InitialView = msoFileDialogViewList    'msoFileDialogViewThumbnail

        If .show = 0 Then
           'There is a problem
           Exit Function
        End If

    'Save the first file selected
    UserPick1File = Trim(.SelectedItems(1))
End With
End Function

 

[theDBguy]

I was going to say maybe you could also try using Regular Expressions.

 

[AHeyne]

The information is always on the same spot.

If it is like you say, then you could use the following code to extract the information of the string which has been read from the file.

The constant 'LINEBREAK_TO_USE' should be 'vbCrLf', 'vbCr' or 'vbLf', depending on the line break used in the file.

The variable 'source' ist just to hold the content of the file.

Const LINEBREAK_TO_USE As String = vbCrLf

Dim source As String
source = "Serial Number: Serial Number:  MXL44832H7" & LINEBREAK_TO_USE & _
         "Bitlocker Key: FS@HomeWork" & LINEBREAK_TO_USE & _
         LINEBREAK_TO_USE & _
         "Bitlocker Recovery Key" & LINEBREAK_TO_USE & _
         "{2414C6B9-82E0-4E04-99BF-8CFFBEF158F9}" & LINEBREAK_TO_USE & _
         "720137-226402-540628-314754-227590-708356-510686-083391"

Dim lines() As String
lines = Split(source, LINEBREAK_TO_USE)

Dim lineParts() As String

Dim part1 As String
lineParts = Split(lines(0), " ")
part1 = lineParts(UBound(lineParts))

Dim part2 As String
lineParts = Split(lines(1), " ")
part2 = lineParts(UBound(lineParts))

Dim part3 As String
part3 = lines(5)

Debug.Print part1
Debug.Print part2
Debug.Print part3

 

[loquito88]

Thank You. It worked like a charm!!!

 

[loquito88]

Hi, I was able to get data into the fields but i get and error . Also im being request to get date of the file and put it n L2 field

Can you help me please. Thanks

 

[Gasman]

Now crossposted at https://www.accessforums.net/showthread.php?t=90583

 

[arnelgp]

you may also try to copy the following code:

' pass the path + filename
Public Function fnGetBitLockerKey(ByVal TextFilepath) As String
    Dim i As Integer, j  As Integer, content As String
    content = Trim$(Replace$(fnGetTextfileContent(TextFilepath), vbCrLf, " ")) & " "
    i = InStrRev(content, "Bitlocker key:")
    If i <> 0 Then
        content = LTrim$(Mid$(content, i + Len("Bitlocker key:")))
        j = InStr(1, content, " ")
        If j <> 0 Then
            fnGetBitLockerKey = Trim$(Left$(content, j - 1))
        End If
    End If
End Function

' pass the path + filename
Public Function fnGetBitlockerRecovery(ByVal TextFilepath) As String
    Dim i As Integer, j  As Integer, content As String
    content = Trim$(Replace$(fnGetTextfileContent(TextFilepath), vbCrLf, " ")) & " "
    i = InStrRev(content, "}")
    If i <> 0 Then
        content = Mid$(content, i + 3)
        j = InStr(1, content, " ")
        If j <> 0 Then
            fnGetBitlockerRecovery = Trim$(Left$(content, j - 1))
        End If
    End If
End Function

Public Function fnGetTextfileContent(ByVal TextFilepath As String) As String
With CreateObject("scripting.filesystemobject").OpenTextfile(TextFilepath, 1)
    fnGetTextfileContent = .ReadAll
    .Close
End With
End Function

to get the Serial:

me.sn = fnGetSerial("c:\path\textfile.txt")

to get the bitlocker key:

me.bitlockKey = fnGetBitLockerKey("c:\path\textfile.txt")

and the bitlocker recovery key:

mebitLockRecoveryKey = fnGetBitlockerRecovery("c:\path\textfile.txt")

 

[Solo712]

Hi, I was able to get data into the fields but i get and error . Also im being request to get date of the file and put it n L2 field
View attachment 117868

View attachment 117869

Can you help me please. Thanks

This is because the yellowed line attempts to read past the end of file. Remove the line and place the

Line Input #1, Vline

on top of the loop below the

While Not EOF(1)

line.

Best,
Jiri