Determinar el tamaño de los accesorios de acceso
Ayudar en un foro Pregunta en la que el usuario de acceso preguntaba cómo podíamos determinar el tamaño del archivo de los archivos almacenados como archivos adjuntos.
Ahora, pasando por alto todo el tema de por qué uno nunca debe usar el tipo de datos de archivos adjuntos:
Continuar leyendo
Sé que muchos lo hacen y tal vez esta solución puede ayudar a otros.
Ahora la solución obvia sería guardar el archivo adjunto al disco (ORS.Fields («Filedata»). Savetofile …) y luego usar una función como Filelen para determinar su tamaño. Sin embargo, este no es el mejor enfoque y podemos hacerlo mejor.
Los accesorios en el acceso nos exponen un par de ‘propiedades’, como:
- Nombre del archivo
- Tipo de filete
- Archivata
Es esta última propiedad que podemos utilizar para determinar el tamaño del archivo en la memoria, sin necesidad de guardarlo primero en disco.
A continuación se muestra un ejemplo de cómo se puede hacer:
Sub GetAttachmentFileSize() ' On Error GoTo Error_Handler Dim oRs As DAO.Recordset2 Dim oRsAttachment As DAO.Recordset2 Dim sFilename As String Dim lFileSize As Long Dim sFileType As String Set oRs = CurrentDb.OpenRecordset("Employees") Debug.Print "Filename", "Type", "Size (b)" Debug.Print String(80, "-") Do While Not oRs.EOF If Not IsNull(oRs.Fields("Pics").Value) Then Set oRsAttachment = oRs.Fields("Pics").Value Do While Not oRsAttachment.EOF sFilename = oRsAttachment.Fields("FileName").Value lFileSize = LenB(oRsAttachment.Fields("FileData").Value) sFileType = oRsAttachment.Fields("FileType").Value Debug.Print sFilename, sFileType, lFileSize & " bytes", sFileType oRsAttachment.MoveNext Loop oRsAttachment.Close End If oRs.MoveNext Loop Error_Handler_Exit: On Error Resume Next oRs.Close Set oRsAttachment = Nothing Set oRs = Nothing Exit Sub Error_Handler: MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _ "Error Source: GetAttachmentFileSize" & vbCrLf & _ "Error Number: " & Err.Number & vbCrLf & _ "Error Description: " & Err.Description & _ Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _ , vbOKOnly + vbCritical, "An Error has Occurred!" Resume Error_Handler_Exit End Sub
Tenga en cuenta que el acceso parece agregar 20-22 bytes al archivo FileData, por lo que para un valor más preciso Resta 20.
Otra solución a esto sería guardar el tamaño del archivo en la tabla cuando se agrega el archivo adjunto a la base de datos. De esta manera, siempre está disponible y no se requiere una gimnasia VBA.
Si realmente desea guardar los archivos en el disco y luego use filelen () para obtener el tamaño del archivo de disco, a continuación se muestra un ejemplo de cómo se puede hacer:
Sub GetAttachmentFileSize2() ' 'On Error GoTo Error_Handler Dim oRs As DAO.Recordset2 Dim oRsAttachment As DAO.Recordset2 Dim sSaveAsFilename As String Dim sFilename As String Dim lLenBFileSize As Long Dim lFileSize As Long Dim sFileType As String Set oRs = CurrentDb.OpenRecordset("Employees") Debug.Print "Filename", "Type", "FileLen Size (b)", "LenB Size (b)", "Diff" Debug.Print String(80, "-") Do While Not oRs.EOF If Not IsNull(oRs.Fields("Pics").Value) Then Set oRsAttachment = oRs.Fields("Pics").Value Do While Not oRsAttachment.EOF sFilename = oRsAttachment.Fields("FileName").Value lLenBFileSize = LenB(oRsAttachment.Fields("FileData").Value) sFileType = oRsAttachment.Fields("FileType").Value sSaveAsFilename = Application.CurrentProject.Path & "\" & oRs!(EmployeeId) & "-" & sFilename If (Len(Dir(sSaveAsFilename)) > 0) Then Kill sSaveAsFilename oRsAttachment.Fields("FileData").SaveToFile sSaveAsFilename lFileSize = FileLen(sSaveAsFilename) Debug.Print sFilename, sFileType, lFileSize & " bytes", lLenBFileSize & " bytes", lLenBFileSize - lFileSize oRsAttachment.MoveNext Loop oRsAttachment.Close End If oRs.MoveNext Loop Error_Handler_Exit: On Error Resume Next oRs.Close Set oRsAttachment = Nothing Set oRs = Nothing Exit Sub Error_Handler: MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _ "Error Source: GetAttachmentFileSize2" & vbCrLf & _ "Error Number: " & Err.Number & vbCrLf & _ "Error Description: " & Err.Description & _ Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _ , vbOKOnly + vbCritical, "An Error has Occurred!" Resume Error_Handler_Exit End Sub