Private RS As DAO.Recordset
Public Function GetFile() As String
' Set up the File Dialog.
Dim fdialog As FileDialog
Set fdialog = Application.FileDialog(msoFileDialogFilePicker)
With fdialog
' Allow user to make multiple selections in dialog box
.AllowMultiSelect = False
' Set the title of the dialog box.
.Title = "Please select a file"
' Clear out the current filters, and add your own.
.Filters.Clear
.Filters.Add "Text File", "*.txt"
'.Filters.Add "All Files", "*.*"
' Show the dialog box. If the .Show method returns True, the
' user picked at least one file. If the .Show method returns
' False, the user clicked Cancel.
If .Show = True Then
'Loop through each file selected and add it to our list box.
If fdialog.SelectedItems(1) <> vbNullString Then
GetFile = fdialog.SelectedItems(1)
End If
Else
MsgBox "You clicked Cancel in the file dialog box."
End If
End With
End Function
Public Sub ReadLineByLine(strFile As String)
' ***************************************************
' * Open a Text File And Loop Through It *
' ***************************************************
Dim IntFile As Integer
Dim StrIn As String
Dim TheTitle As String
Dim TheSN As String
Dim TheManufacturer As String
Dim TheModelNumber As String
Dim TheRawSize As String
Dim TempArray() As String
IntFile = FreeFile()
Set RS = CurrentDb.OpenRecordset("tblEquip")
Open strFile For Input As #IntFile
Do While Not EOF(IntFile)
'Move to title
Do While Not EOF(IntFile)
If InStr(StrIn, "Title = ") Then Exit Do
Line Input #IntFile, StrIn
Loop
TheTitle = FindAfter(StrIn, "Title = ")
Line Input #IntFile, StrIn
TheSN = FindAfter(StrIn, "SN = ")
Line Input #IntFile, StrIn
TheManufacturer = FindAfter(StrIn, "Manufacturer = ")
Line Input #IntFile, StrIn
TheModelNumber = FindAfter(StrIn, "ModelNumber = ")
Line Input #IntFile, StrIn
TheRawSize = FindAfter(StrIn, "Rawsize = ")
InsertEquipment TheTitle, TheSN, TheManufacturer, TheModelNumber, TheRawSize
Loop
Close #IntFile
RS.Close
End Sub
Public Function FindAfter(ByVal SearchIn, ByVal SearchAfter) As String
'This will find the text after a given search for text. The text is considered as a single item if no more than one space in the text
'Do not know if this is any faster, probably not. Makes the code a little more reuseable
'SEGMENT : CLASS7 Print Date 04-07-2018 12:40:37 Page 3 of 2000
'If SearchAfter = "SEGMENT :" then it returns CLASS7, if "Print Date" it returns "04-07-2018 12:40:37", and "Page" returns "3 or 2000"
SearchIn = CleanAndRemoveSpaces(SearchIn)
FindAfter = Trim(Split(SearchIn, SearchAfter)(1))
FindAfter = Trim(Split(FindAfter, " ")(0))
End Function
Public Function FindBefore(ByVal SearchIn, SearchBefore) As String
'This will find the text before. The text is considered as a single item if no more than one space in the text
Dim aBefore() As String
SearchIn = CleanAndRemoveSpaces(SearchIn)
FindBefore = Trim(Split(SearchIn, SearchBefore)(0))
aBefore = Split(FindBefore, " ")
'find last element to left
FindBefore = Trim(aBefore(UBound(aBefore)))
End Function
Public Sub InsertEquipment(TheTitle As String, TheSN As String, TheManufacturer As String, TheModelNumber As String, TheRawSize As String)
RS.AddNew
RS!EquipTitle = TheTitle
RS!EquipSn = TheSN
RS!equipManufacturer = TheManufacturer
RS!equipModelNumber = TheModelNumber
RS!equipSize = TheRawSize
RS.Update
Exit Sub
errlbl:
Debug.Print Err.Number & " " & Err.Description
Resume Next
End Sub
