problem getting file size (1 Viewer)

Andy Mc

New member
Local time
Today, 12:19
Joined
May 6, 2012
Messages
16
Hi
Can anyone shed light on what I'm doing wrong with the code below. I'm trying to get the size of each pdf file within folder c:\attachments\ and insert this (with file name) into table "temp". I get "file not found" when I try to run it.
I've also tried using FileLength = MyFile.size instead of FileLength = FileLen(MyFile), but I get invalid qualifier
I'm a newbie to VBA so any help would be much appreciated.

Public Function ImportPDF()
Dim MyFile As String
Dim file As String
Dim FileLength As Long
Dim db As Database
Dim sSQL As String

Set db = CurrentDb()
If Right(strPath, 1) <> "" Then strPath = strPath & ""
If strFilter = "" Then strFilter = "*"

MyFile = Dir$("c:\attachments\" & "*." & "pdf")
Do While MyFile <> ""
FileLength = FileLen(MyFile)
sSQL = "INSERT INTO temp(attachment, size) VALUES(""" & MyFile & """, """ & FileLength & """)"
db.Execute sSQL, dbFailOnError
MyFile = Dir$
Loop
Forms![attachment]![attachment sub2].Requery
Error_Handler_Exit:
On Error Resume Next
Set db = Nothing
Exit Function

Error_Handler:
MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: ImportDirListing" & vbCrLf & _
"Error Description: " & Err.Description, vbCritical, _
"An Error has Occured!"
Resume Error_Handler_Exit
End Function
 

Simon_MT

Registered User.
Local time
Today, 12:19
Joined
Feb 26, 2007
Messages
2,177
This works for a single image (jpg) file using File System Object and would need some modification. GetPicturePath is the file name.

Code:
Function GetPictureSize()

Dim fs, f
    With CodeContextObject
        Set fs = CreateObject("Scripting.FileSystemObject")
        Set f = fs.GetFile(GetPicturePath)
        GetPictureSize = f.Size
        Set f = Nothing
        Set fs = Nothing
    End With
End Function

Simon
 

VilaRestal

';drop database master;--
Local time
Today, 12:19
Joined
Jun 8, 2011
Messages
1,046
I think perhaps GetPicturePath should be an argument to the GetPictureSize function Simon. (And I don't get why 'With CodeContextObject'. That doesn't seem to be used.)

Code:
Function GetFileSize(ByVal FilePath As String) As Long
    Dim fs, f
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFile(FilePath)
    GetFileSize = f.Size
    Set f = Nothing
    Set fs = Nothing
End Function

As for your code Andy:

I'm not sure about the lines:


If Right(strPath, 1) <> "" Then strPath = strPath & ""
If strFilter = "" Then strFilter = "*"

Those variables don't seem to be used. And the first one does nothing as far as I can work out (if last character is not "" then append "" (then do nothing)?)

But as for the loop, this is how I would do it:

Code:
Dim i As Long
For i = 0 To UBound(MyFile)
    sSQL = "INSERT INTO temp(attachment, size) VALUES(""" & MyFile(i) & """, " & GetFileSize(MyFile(i)) & ")"
    db.Execute sSQL, dbFailOnError
Next i
 
Last edited:

Andy Mc

New member
Local time
Today, 12:19
Joined
May 6, 2012
Messages
16
Hi
Thanks to you both for your suggestions. I tried each but still had a problem. After a bit of head banging I checked out what MyFile was returning and it turns out that it was the path that was missing.However, your suggestions got me on the path to success.
Here's what I ended up with:

Option Compare Database
Option Explicit

Public Function ImportPDF()
Dim MyFile As String
Dim file As String
Dim db As Database
Dim sSQL As String
Set db = CurrentDb()
MyFile = Dir$("c:\attachments\" & "*." & "pdf")
Do While MyFile <> ""
file = "c:\attachments\" & MyFile
sSQL = "INSERT INTO temp(attachment, size) VALUES(""" & MyFile & """, " & GetFileSize(file) & ")"
db.Execute sSQL, dbFailOnError
MyFile = Dir$
Loop
Forms![attachment]![attachment sub2].Requery
Error_Handler_Exit:
On Error Resume Next
Set db = Nothing
Exit Function

Error_Handler:
MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: ImportDirListing" & vbCrLf & _
"Error Description: " & Err.Description, vbCritical, _
"An Error has Occured!"
Resume Error_Handler_Exit
End Function
Function GetFileSize(ByVal FilePath As String) As Long
Dim fs, f
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile(FilePath)
GetFileSize = f.size
Set f = Nothing
Set fs = Nothing
End Function
 

Users who are viewing this thread

Top Bottom