I am in the midst of migrating an Access 2003 database to Access 2007 and one of its most important module uses the filesearch object to transfer table data from word files into a table in the databse. I know filesearch isnt supported anymore and I have tried to find solutions that are suitable for my needs but have not found any. I am a novice programmer with no vba experience so help is greatly appreciated!
Code:
Code:
Code:
Option Compare Database
Option Explicit
Public Function ImportPathTableData()
Dim objWord As Object
Dim objDoc As Word.Document
Dim db As Database
Dim data As Recordset
Dim bWord As Boolean
Dim strFolderName, strNPID, strTemp As String
Dim tablenb, table, row, column, i As Integer
Set objWord = CreateObject("Word.Application")
' Get folder with new files to sort data from
strFolderName = BrowseFolder("What Folder contains only the new NP reports to fetch data from?")
If strFolderName = "" Then
Exit Function
End If
' Find and gather files for import in above folder
With Application.FileSearch
.NewSearch
.LookIn = strFolderName
.SearchSubFolders = False
.FileName = "NA*"
.MatchTextExactly = False
.FileType = msoFileTypeWordDocuments
End With
With Application.FileSearch
' If files are found, import content
If .Execute() > 0 Then
Set db = CurrentDb()
Set data = db.OpenRecordset("Data", dbOpenTable)
For i = 1 To .FoundFiles.count
' Open in Word
Set objDoc = Documents.Open(FileName:=.FoundFiles(i))
' Extract NA number from file
' use row, column variables to mark start and end of said string
row = InStr(1, .FoundFiles(i), "NA")
column = InStr(1, .FoundFiles(i), ".doc")
strNPID = Mid$(.FoundFiles(i), row, column - row)
' Check for tables
tablenb = ActiveDocument.content.Tables.count
If tablenb > 0 Then
' Perform filtering/parsing of each table
' one column at a time. Each column is a ResultType
' and each row is a RegionType.
For table = 1 To tablenb
row = ActiveDocument.content.Tables(table).Rows.count
column = ActiveDocument.content.Tables(table).Columns.count
For column = 2 To ActiveDocument.content.Tables(table).Columns.count
For row = 2 To ActiveDocument.content.Tables(table).Rows.count
data.AddNew
data!NPID = strNPID
data!ResultID = Nz(DMax("[ResultID]", "Data", "[NPID]='" & strNPID & "'"), 0) + 1
ActiveDocument.content.Tables(table).Cell(row:=1, column:=column).Select
strTemp = Left$(Selection.Text, Len(Selection.Text) - 2)
data!ResultType = IIf((strTemp = ""), Null, strTemp)
ActiveDocument.content.Tables(table).Cell(row:=row, column:=1).Select
strTemp = Left$(Selection.Text, Len(Selection.Text) - 2)
data!RegionType = IIf((strTemp = ""), Null, strTemp)
ActiveDocument.content.Tables(table).Cell(row:=row, column:=column).Select
strTemp = Left$(Selection.Text, Len(Selection.Text) - 2)
data!ResultValue = IIf((strTemp = ""), Null, strTemp)
data!DateAdded = Now()
data.Update
Next row
Next column
Next table
End If
' Now, add records for info to be added manually
AddDataEntries (strNPID)
' Close file in Word now that we are done
objDoc.Close savechanges:=False
Next i
' else, there were no NA files in said folder
Else
MsgBox "There were no files found."
End If
End With
If bWord Then objWord.Application.Quit
Set objDoc = Nothing: Set objWord = Nothing
End Function