Option Compare Database
Option Explicit
Const TABLENAME As String = "tblImportedCode"
Const REPORTSPATH As String = "C:\Backups\Access\Code\"
Const DblQuote As String = """"
Public Sub ImportCodeFilesToModules()
Dim db As DAO.database
Dim rs As DAO.Recordset
Dim intFileNumber As Integer
Dim strFileName As String
Dim strLine As String
Dim datDate As Date
Dim strSourceFile As String
Dim intFileSize As String
Dim intFileCount As Integer
Dim mdl As Module
Dim intPos As Integer, i As Integer
Dim strModuleName As String
DoCmd.SetWarnings False
Close
Set db = CurrentDb
Set rs = db.OpenRecordset(TABLENAME)
intFileCount = 0
strFileName = Dir(REPORTSPATH & "*.*")
Do While strFileName <> ""
If InStr(1, strFileName, ".zip") = 0 And InStr(1, strFileName, ".doc") = 0 And InStr(1, strFileName, ".exe") = 0 And _
InStr(1, strFileName, ".mdb") = 0 And InStr(1, strFileName, ".ppt") = 0 Then
intFileCount = intFileCount + 1
Close
strSourceFile = REPORTSPATH & strFileName
intFileNumber = FreeFile
Open strSourceFile For Input As #intFileNumber
datDate = CDate(Format(FileDateTime(strSourceFile), "mm/dd/yyyy"))
intFileSize = FileLen(strSourceFile)
intPos = InStr(1, strFileName, ".")
If intPos = 0 Then
strModuleName = "mod" & strFileName
Else
strModuleName = "mod" & Left(strFileName, intPos - 1) & "_" & Mid(strFileName, intPos + 1)
End If
On Error Resume Next
If Not IsError(db.Containers("Modules").Documents(strModuleName)) Then
If Err.Number <> 3265 Then
For i = 1 To 20 Step 1
strModuleName = strModuleName & i
If IsError(db.Containers("modules").Documents(strModuleName)) Then
If Err.Number <> 3265 Then
strModuleName = strModuleName & i
Else
Exit For
End If
End If
Next 'i
End If
End If
' Create the module.
DoCmd.RunCommand acCmdNewObjectModule
' Set MyModule to be the new Module Object.
Set mdl = Application.Modules.item(Application.Modules.Count - 1)
' Save, close, and rename the new Module.
DoCmd.Save acModule, mdl
DoCmd.close acModule, mdl, acSaveYes
DoCmd.Rename strModuleName, acModule, mdl
DoCmd.OpenModule strModuleName
Set mdl = Modules(strModuleName)
mdl.AddFromString "'File Date: " & datDate
mdl.AddFromString "'File Size: " & intFileSize & " bytes"
Do While Not EOF(intFileNumber)
Line Input #intFileNumber, strLine
If Len(strLine) = 0 Then strLine = " "
mdl.AddFromString "' " & strLine
Loop
DoCmd.close acModule, strModuleName, acSaveYes
Close
End If
strFileName = Dir
Loop
MsgBox "Completed importing " & intFileCount & " files.", vbInformation + vbOKOnly, "I M P O R T I N G C O M P L E T E"
rs.close: Set rs = Nothing
db.close: Set db = Nothing
DoCmd.SetWarnings True
End Sub