Hi I have some code which was written in version 2000 that will not run in 2007.
Our IT is forcing us down the route of moving to 2007 and I've been encountering loads of problems, for now I'm looking to find out why the code below will not run in 2007.
Any assistance would be most appreciated.
Regards
John
Our IT is forcing us down the route of moving to 2007 and I've been encountering loads of problems, for now I'm looking to find out why the code below will not run in 2007.
Any assistance would be most appreciated.
Code:
Function eFlowProcess1()
On Error Resume Next
'=============================================
'References:
'Visual Basic For Applications
'Microsoft Access 9.0 Object Library
'Microsoft DAO 3.6 Object Library
'Microsoft Excell 11.0 Object Library
'Microsoft Outlook 14.0 Object Library
'Microsoft Word 14.0 Object Library
'Microsoft Scripting Runtime
'OLE Automation
'Microsoft ActiveX Date Objects 2.1 Library
'Microsoft Outlook View Control
'=============================================
DoCmd.Echo False, "Running Program - mod_eFlowProcess1" 'Indicates in the progress bar the program is running
DoCmd.Hourglass True 'Turn on the Hourglass
DoCmd.SetWarnings False 'Turn off warnings
Dim filenum As Integer 'Declare the filenum variable
Dim Count As Long 'Declare the count variable as Long
Dim tmp As String 'Declare the tmp variable as string
Dim rst As DAO.Recordset 'Declare rst as DAO Recordset
Dim DB As Database 'Declare DB as the Database
Dim FS As FileSystemObject 'Declares the File System Object
Dim Folder As Folder 'Declares the Folder Object
Dim subFolder As Folder 'Declare the SubFolder Object
Dim File As File 'Declares the File Object
Dim TextFilePath 'Declares the TextFilePath variable
Dim dtmDate As Date 'Declare the dtmDate variable
Dim dtmFileDate As Date 'Declare the dtmFileDate variable
Dim TextFileDate 'Declare the TextFileDate variable
Dim NameOfFile 'Declare the NameOfFile variable
Dim FileNameWithExt 'Declare the FileNameWithExt variable
Dim strTemp As String 'Declare the strTemp variable
Dim FileLoc As String 'Declare the FileLoc variable
StartTime = Format(Now(), "hh:mm:ss") 'Assign the current time to the StartTime variable
Const ForReading = 1 'Declare the FoReading Constant
Set DB = CurrentDb 'Set DB as the current Database
Set FS = CreateObject("Scripting.FileSystemObject") 'Set the File System Object
dtmDate = Date 'Assign the system date to the dtmDate variable
TextFilePath = "B:\" 'Set the text file path here [the location where text files are be stored]
'====================
'Return Mail Process
'====================
If FS.FileExists("B:\rtmail\rtmail.txt") = True Then 'Checks to see if the rtmail.txt file exists in the B:\rtmail folder, if it does then
If FS.FileExists("B:\rtmail.fof\rtmail.txt") = True Then 'Checks to see if the rtmail.txt file exists in the B:\rtmail.fof folder, if it does then
Dim SourceNum As Integer 'Declare the SourceNum variable as Integer
Dim DestNum As Integer 'Declare the DestNum variable as Integer
DestNum = FreeFile() 'Open the destination text file
Open "B:\rtmail.fof\rtmail.txt" For Append As DestNum
SourceNum = FreeFile() 'Open the source text file
Open "B:\rtmail\rtmail.txt" For Input As SourceNum
Do While Not EOF(SourceNum) 'Read each line of the source file and append it to the destination file
Line Input #SourceNum, Temp
Print #DestNum, Temp
Loop
Close #DestNum 'Close the Destinationtext file
Close #SourceNum 'Close the Source text file
Kill "B:\rtmail\rtmail.txt"
Else
If FS.FileExists("B:\rtmail\rtmail.txt") = True Then 'If the rtmail.txt file exists then
FS.CopyFile "B:\rtmail\rtmail.txt", "B:\rtmail.fof\rtmail.txt" 'Copy the Return Mail text file to the new Folder
Kill "B:\rtmail\rtmail.txt" 'Delete the rtmail.txt file from the rtmail folder
End If
End If
End If
Set Folder = FS.GetFolder(TextFilePath) 'Open the text file folders
For Each subFolder In Folder.SubFolders 'Loops through the Folders looking for SubFolders
For Each File In subFolder.Files 'Loops through Subfolders looking for Files
NameOfFile = GetAttr("File.Name") 'Get the text file name
If Right(File.Name, 4) = ".txt" Then 'If the file found has a ".txt" extension then
FileNameWithExt = Mid$(File.Name, InStrRev(File.Name, "\") + 1) 'Assign the File Name with its extension type to the FileNameWithExt variable for example aeg.fof
strTemp = Mid$(File.Name, InStrRev(File.Name, "\") + 1) 'Assign the text file name to the strTemp variable for example aeg.fof
NameOfFile = Left$(strTemp, InStrRev(strTemp, ".") - 1) 'Assign the name of the text file without the extension type to the NameOfFile variable for example aeg
subFilePath = Left$(subFolder, InStrRev(subFolder, "\")) 'Assign the Directory location of the sub file path to the SubFilePath variable in this case B:\
SubFolderName = Mid$(subFolder, InStr(3, subFolder, "\")) 'Assign the name of the sub folder to the SubFolderName variable for example \aeg.fof
FileLoc = subFolder & "\" & File.Name 'Assign the subFolder and File.Name to the FileLoc variable
If Dir("G:\Scan - Verify\eFlow\BackupProdRegOnprdfs01" & SubFolderName, vbDirectory) = "" Then 'If the SubFolderName doesn't exist in the G:\Scan - Verify\eFlow\BackupProdRegOnprdfs01 Folder then
MkDir ("G:\Scan - Verify\eFlow\BackupProdRegOnprdfs01" & SubFolderName) 'Create the SubFolderName in the G:\Scan - Verify\eFlow\BackupProdRegOnprdfs01 Folder
FS.CopyFile subFolder & "\" & FileNameWithExt, "G:\Scan - Verify\eFlow\BackupProdRegOnprdfs01" & SubFolderName & "\" & NameOfFile & "_" & Format(Date, "ddmmyy") & ".txt" 'Copy the text file from the B Drive into the G:\Scan - Verify\eFlow\BackupProdRegOnprdfs01 subFolder and add the current date
Else 'Else if the SubFolderName does exist then
FS.CopyFile subFolder & "\" & FileNameWithExt, "G:\Scan - Verify\eFlow\BackupProdRegOnprdfs01" & SubFolderName & "\" & NameOfFile & "_" & Format(Date, "ddmmyy") & ".txt" 'Copy the text file from the B Drive into the G:\Scan - Verify\eFlow\BackupProdRegOnprdfs01 subFolder and add the current date
End If
filenum = FreeFile 'Get unused file number
Open FileLoc For Input As filenum 'Open the text file for input as the file number
Do While Not EOF(filenum) 'Loop while not the End of File
Line Input #filenum, tmp$
Count = Count + 1 'Count the lines and increment
Loop
Close #filenum 'Close the text file
Set rst = DB.OpenRecordset("tblFileExists") 'Set rst to Open the tblFileExists table
rst.AddNew 'Add a new record to the File Exists table
rst!strFileExists = File.Name 'Add File.Name as a record to the tblFileExists table.
rst!lngRecordCount = Count 'Assign the value of the count variable to the lngRecordCount Field
rst.Update 'Write the record to the database
rst.Close 'Close the recordset.
Set rst = Nothing 'Reset the rst variable to nothing
Count = 0 'Set the count variable to zero
End If
DoEvents 'Passes control to the operating system so it can process other events
DoCmd.Echo True, "PROCESS 1: Copying Text Files To Backup Location: " & NameOfFile & "_" & Format(Date, "ddmmyy") & ".txt" 'Indicates in the progress bar the file being worked on
Next
Next
Call eFlowProcess2 'Call the eFlowProcess2 Module
DoCmd.Echo True, "Program End" 'Update the progress bar with the words "Program End"
DoCmd.Hourglass False 'Turn the Hourglass off
DoCmd.SetWarnings True 'Turn the warnings on
End FunctionRegards
John
