Here is another procedure that works with files in
folders. Also, Jason, regarding your question about
having to validate files, that would only be necessary if
you are trying to keep track of which files have been
imported and which have not. If you just want to import
or link all files, it wouldn't be necessary.
Following is a procedure that I use to add hyperlinks for
users automatically. It isn't related to
importing/linking files, but gives another example of
looping through files in a folder.
'This module is designed to automatically add hyperlinks
to files that are stored in the project folder
'but not yet linked to the database.
'Project folders are stored under \Doclinks\WCIP.
Beneath that folder, there are folders that contain
'groups of 50 project folders. For example "00001 to
00050".
'Within each group folder, there are 50 individual
folders named simply according to the 5-digit project ID.
'For example "00001"
'Project numbers are always in 5-digit format for naming
consistency.
'Within each project folder, individual files are
supposed to be named using the following format:
'#####_YY-MM-DD_#.*, where the first 5 numbers are
the Project ID, then the date, then a serial number
'(to allow for more than one document per day). Of
course each file keeps the extension of the associated
'application.
'Check to see if the user has clicked on a blank field.
If not, exit the sub
'This sub is designed to only run when the user clicks on
a blank field.
If IsNull(Me.Doc_Hyperlink) = False Then
Exit Sub
End If
'Dimension a variable to receive the currently selected
Project ID (if there is one), one to construct a string
'to prompt a user for confirmation, and one to store the
users response
'Other variables are dimensioned after checking to see if
code will progress.
Dim intEmployeeID As Integer, strMessage As String,
intUserResponse As Integer
'Check to see if an employee name has been chosen
'This sub is designed to run only after an employee name
has been chosen so that the name can be assigned
'to all of the new links that will be created.
If IsNull(Me.Employee_ID_Link) Then
'If an employee name has not been selected, notify
the user and exit the sub.
MsgBox "Please select your name to the right to enter
new hyperlink(s)"
Exit Sub
Else
'If an employee name is selected, assign the ID to
the intEmployeeID variable
intEmployeeID = Me.Employee_ID_Link
End If
'Construct a message to ask the user if they want the
unlinked documents to be automatically linked
'First part of string
strMessage = "Click YES if you would like to
automatically add links to all unlinked "
'Additional text and a blank line
strMessage = strMessage & "documents in the folder for
this project." & Chr(13) & Chr(10) & Chr(10)
'Additional text
strMessage = strMessage & "Otherwise, click NO to
manually add a link."
'Display message box with the constructed string,
show "Yes" and "No" buttons, title the dialog with
'"Automatically Add Links?", and assign the users
response to the intUserResponse variable
intUserResponse = MsgBox(strMessage,
vbYesNo, "Automatically Add Links?")
'Check to see if the user responded "No", which would
mean that they don't want to automatically link the files
If intUserResponse = vbNo Then
'If the user answered "No" exit the procedure.
Exit Sub
End If
'At this point, code will progress to the end, so the
remaining variables are dimensioned
Dim strInitialFolder As String, fs, intRelPathFileLen As
Integer
Dim strProjID As String, lngProjID As Long, strLBNumber
As String, strUBNumber As String
Dim dbs As Database, qdef As QueryDef, rstDocLinks As
Recordset
Dim blnFound As Boolean, intCountAdds As Integer
'In order to get to this point, the user had to select an
Employee Name, and then click in a blank hyperlink
'field. This means that there is currently a record in
the form that is in edit mode.
'But, now that the selected Employee ID has been
captured, and it has been determined that all
'unlinked documents will be linked in the remaining part
of this procedure, it is necessary to cancel out
'the partial entry of the new record in the form
'Undo the pending entry in the form.
Me.Undo
'Capture the Project ID as a long integer and assign it
to the lngProjID variable.
'It is necessary to get this off of the parent form (f
Master) because there may not be any entries in the
subform
lngProjID = Me.Parent.ID
'Construct the 5-digit ID for the project and assign it
to a string variable titled strProjID.
'This is done by adding four leading zero's to the ID,
then trimming the right 5 characters.
strProjID = Right("0000" & Me.Parent.ID, 5)
'Next, in order to construct the name of the parent
folder to the project folder, it is necessary to construct
'the lower and upper bound numbers of the parent.
'For the Lower Bound number, divide the project ID by 50,
round off to an integer, then multiply by 50
'and finally add 1 to the result. Then append the result
to four 0's, and trim the right 5 characters.
'For example, if Proj ID = 238, divide by 50 and round
off = 4, multiply by 50 = 200, add 1 = 201,
'append to four 0's = 0000201, take right five characters
= 00201
strLBNumber = Right("0000" & (Int((Me.Parent.ID - 1) /
50) * 50) + 1, 5)
'For the Upper Bound number, divide the project ID by 50,
round off to an integer, add 1, then multiply by 50.
'Then append the result to four 0's, and trim the right 5
characters.
'For example, if Proj ID = 238, divide by 50 and round
off = 4, add 1 = 5, multiply by 50 = 250,
'append to four 0's = 0000250, take right five characters
= 00250
strUBNumber = Right("0000" & (Int((Me.Parent.ID - 1) /
50) + 1) * 50, 5)
'Now, begin to construct the full file path by starting
with the portion of the path that is constant and
'assigning it to the strInitialFolder string variable.
strInitialFolder = "\\82cvcfs1
\fmd\CIP\Database\Doclinks\WCIP\"
'Append the Lower Bound number, a space, the word "to",
another space, the Upper Bound number,
'a slash, and the 5 digit project ID string.
'For the earlier sample (project 238), this would equate
to:
'\\82cvcfs1\fmd\CIP\Database\Doclinks\WCIP\00201 to 00250
\00238\
strInitialFolder = strInitialFolder & strLBNumber & "
to " & strUBNumber & "\" & strProjID & "\"
'Initialize to 0 the variable that will be used to count
how many doclinks get added by this procedure
intCountAdds = 0
'Assign the variable fs to represent
Application.Filesearch
Set fs = Application.FileSearch
'With Application.Filesearch do the following
With fs
'Set the folder to the variable strInitialFolder,
which was constructed earlier to represent the project
folder.
.lookin = strInitialFolder
'Set the filetype to find all file types
.FileType = msoFileTypeAllFiles
'.FileTypes.Add msoFileTypeAllFiles
'Set the file name criteria to find all file names
.FileName = "*.*"
'If any files are found
If .Execute() > 0 Then
'Assign the variable dbs to represent the current
database
Set dbs = CurrentDb
'Assign the variable qdef to represent the
query "q DocHyperlinks" within the current database.
Set qdef = dbs.QueryDefs("q DocHyperlinks")
'Set the [EnterProjID] parameter equal to the
current project ID. This will limit the recordset
'to only the records matching this project.
qdef.Parameters("EnterProjID") = lngProjID
'Open a recordset using the qdef query definition
as a dynaset type
Set rstDocLinks = qdef.OpenRecordset
(dbOpenDynaset)
'Do the following loop for each file found in the
project folder
For i = 1 To .FoundFiles.Count
'Extract just the relative portion of the
path and the filename by subtracting the constant
'"\\82cvcfs1\fmd\CIP\Database\Doclinks\WCIP\"
which is 42 characters
'First, find the total lenght of the path and
file name and subtract 42 to find
'the size to be extracted and assign the
result to the intRelPathFileLen variable
intRelPathFileLen = Len(.FoundFiles(i)) - 42
'Now, extract that number of characters from
the right side of the full path to get the relative
'path and filename. Assign the result to the
strRelPathFile variable.
strRelPathFile = Right(.FoundFiles(i),
intRelPathFileLen)
'With the rstDocLinks recordset (created
earlier from the query definition)
With rstDocLinks
'Move to the first record
.MoveFirst
'Initialize blnFound as false - this will
be set to true if the current file is found in the
'recordset, meaning that it already exists
blnFound = False
'loop through all of the records in the
recordset looking for the current file .foundfiles(i)
Do Until .EOF
'Check to see if the relative path
and filename matches the hyperlink address of the
'current record
If strRelPathFile = ![HypPart2] Then
'If so, set blnFound = true and
exit the do loop.
blnFound = True
Exit Do
End If
'Go to the next record in the
recordset.
'If no more records exist in the
recordset, execution will exit the loop
.MoveNext
Loop
'Check to see if the current file
(.foundfiles(i)) was found in the recordset
If blnFound = True Then
'If so, nothing needs to be done, and
execution will go on to the next (i)
'The following statement was just
used during debugging to display the filename
'and whether it was found.
'MsgBox strRelPathFile & " was found
in tDocRef"
Else
'If the filename wasn't found in the
recordset, it needs to be added (it is an unlinked file)
'Add a new record to the recordset,
note that since the recordset is a dynaset based on a
'query from the tDocRef table, all
updates will pass through to that table.
.AddNew
'Assign the [ProjIDLink]field of the
recordset = the lngProjID variable
![ProjIDLink] = lngProjID
'Assign the [DocHyp] field of the
recordset = the relative path and filename surrounded
'by pound signs (these are needed to
specify that this is the address part of the
'hyperlink
![DocHyp] = "#" & strRelPathFile & "#"
'Assign the employee ID
![EmpIDLink] = intEmployeeID
'Assign the current date and time to
the [Entered] field
![Entered] = Now()
'Post the entry (save it)
.Update
'increment the variable that counts
how many files have been automatically linked
intCountAdds = intCountAdds + 1
'The following statement was just
used during debugging.
'MsgBox strRelPathFile & " was not
found in tDocRef"
End If
End With
Next i
'Close the recordset after all files have been
compared against the recordset
rstDocLinks.Close
Else
'If the filesearch does not find any files,
notify the user and exit the procedure
MsgBox "No files were found in the project folder"
'Requery to be sure that form displays the
records properly since their partial edit was undone.
Me.Requery
Exit Sub
End If
End With
'Requery the subform to display all newly entered
document links.
Me.Requery
'Check to see how many new links were added.
If intCountAdds > 0 Then
'If one link was added, construct the appropriate
message to notify the user and remind them to add the
'file description and check the file name format.
If intCountAdds = 1 Then
strMessage = "1 Document Link was added for this
project." & Chr(13) & Chr(10) & Chr(10)
strMessage = strMessage & "Please add a
description for it and check that it was created with
proper "
strMessage = strMessage & "naming conventions." &
Chr(13) & Chr(10) & Chr(10)
strMessage = strMessage & "If necessary, you can
delete a link by selecting the row containing the "
strMessage = strMessage & "link and pressing the
delete button."
MsgBox strMessage
Else
'If more than one link was added, construct the
appropriate message to notify the user and remind them
'to add the file descriptions and check the file
name formats.
strMessage = intCountAdds & " Document Links were
added for this project." & Chr(13) & Chr(10) & Chr(10)
strMessage = strMessage & "Please add a
description for each one and check that each was created
with "
strMessage = strMessage & "proper naming
conventions." & Chr(13) & Chr(10) & Chr(10)
strMessage = strMessage & "If necessary, you can
delete a link by selecting the row containing the "
strMessage = strMessage & "link and pressing the
delete button."
MsgBox strMessage
End If
End If
End Sub
