Solved Use attachments for html related files, is that possible? (1 Viewer)

Mike Krailo

Well-known member
Local time
Today, 04:35
Joined
Mar 28, 2020
Messages
1,030
I would like to use the concept for using a browser control to display a color picker as shown on Daniel Pinaeult's excellent article found here: Access Color Picker

This requires having separate files in folders as most web projects do. I was thinking maybe all those files could be stored in attachment fields instead of being in the filesystem. Would this be possible? That would avoid having files outside of the database which in my case would be desirable. These files would hardly ever change if ever, I just need the color picker functionality.
 

theDBguy

I’m here to help
Staff member
Local time
Today, 01:35
Joined
Oct 29, 2018
Messages
21,358
I know Attachment Controls can readily display images. Otherwise, I think it would try to display the icon for the associated program instead. However, I am not sure if it will display Text/HTML files. Even if it does, I think it would only good for displaying the first page or first few lines of the file and not be able to interact with it.

On the other hand, a web browser control requires a file path to display the contents of a file. If that's the case, I guess you will have to extract the file from the Attachment field, using the SaveToFile method, before you could use it in the web browser control. So, in short, you could use an Attachment field, but you can't get away from still using a file system for your applications.
 

Mike Krailo

Well-known member
Local time
Today, 04:35
Joined
Mar 28, 2020
Messages
1,030
That essentially answers my question. I didn't want to waste time trying to do something that it cannot do. The form for doing the color picking is essentially a browser control that depends on the html file in the same directory as the database. It has a single html folder and inside is a css folder, js folder and the main index.html file. Your idea of extracting the required files sounds like it just might work. That is acceptable so long as all of the main files are stored in the main DB. I'm thinking a simple check for the main html folder should suffice. If it's not there, extract all the needed files from the DB and then it should work. Thanks for the idea.
 

theDBguy

I’m here to help
Staff member
Local time
Today, 01:35
Joined
Oct 29, 2018
Messages
21,358
That essentially answers my question. I didn't want to waste time trying to do something that it cannot do. The form for doing the color picking is essentially a browser control that depends on the html file in the same directory as the database. It has a single html folder and inside is a css folder, js folder and the main index.html file. Your idea of extracting the required files sounds like it just might work. That is acceptable so long as all of the main files are stored in the main DB. I'm thinking a simple check for the main html folder should suffice. If it's not there, extract all the needed files from the DB and then it should work. Thanks for the idea.
Good luck. Let us know how it goes.
 

MajP

You've got your good things, and you've got mine.
Local time
Today, 04:35
Joined
May 21, 2018
Messages
8,463
Your idea of extracting the required files sounds like it just might work. That is acceptable so long as all of the main files are stored in the main DB. I'm thinking a simple check for the main html folder should suffice. If it's not there, extract all the needed files from the DB and then it should work.
I have done that with other files to make it easy to disritbute. Save as an attachment, check if it exists, download if not, and either delete it or leave it when done. See if any of these are useable.
Code:
Public Sub OpenFirstAttachmentAsTempFile(ByRef rstCurrent As DAO.Recordset, ByVal strFieldName As String)
    Dim rstChild As DAO.Recordset2
    Dim fldAttach As DAO.Field2
    Dim strFilePath As String
    Dim strTempDir As String
    strTempDir = Environ("Temp") ' Get the Temp directory from the environment variable.
    If Right(strTempDir, 1) <> "\" Then strTempDir = strTempDir & "\" ' Make sure the path always ends with a backslash.
    Set rstChild = rstCurrent.Fields(strFieldName).Value ' the .Value for a complex field returns the underlying recordset.
    strFilePath = strTempDir & rstChild.Fields("FileName").Value ' Append the name of the first (and only) attached file to temp dir.
    If Dir(strFilePath) <> "" Then ' the file already exists--delete it first.
        VBA.SetAttr strFilePath, vbNormal ' remove any file attributes (e.g. read-only) that would block the kill command.
        VBA.Kill strFilePath ' delete the file.
     End If
    Set fldAttach = rstChild.Fields("FileData") ' The binary data of the file.
    fldAttach.SaveToFile strFilePath
    rstChild.Close ' cleanup
    VBA.Shell "Explorer.exe " & Chr(34) & strFilePath & Chr(34), vbNormalFocus ' Use Windows Explorer to launch  the file.
End Sub      '
Public Function OpenReportAndSave(strReportName As String) As String
    'Create report and save as an attachment to the current record
    Dim myCurrentDir As String
    Dim myReportOutput As String
    Dim myMessage As String
    On Error GoTo ErrorHandler
    DoCmd.OpenReport strReportName, acViewPreview
    myCurrentDir = CurrentProject.Path & "\"
    myReportOutput = myCurrentDir & strReportName & Format(Date, "YYYYMMDD") & ".pdf"
    DoCmd.OutputTo acOutputReport, strReportName, acFormatPDF, myReportOutput, , , , acExportQualityPrint
    OpenReportAndSave = myReportOutput
    Exit Function
ErrorHandler:
    MsgBox Error$
End Function
Public Sub loadAttachFromFile(strPath As String, rsAll As DAO.Recordset, attachmentFieldName As String)
  'An attachment field has a recordset of attachments stored behind the scenes
  Dim rsAtt As DAO.Recordset
  'Add a new record to the tables recordset
  Set rsAtt = rsAll.Fields(attachmentFieldName).Value
  rsAll.Edit
    rsAtt.AddNew
     'This is the confusing part.  The value property of an attachment field returns a recordset of attachments
     'All recordset of attachments has a field named filedata which holds the data.
     'The loadfromfile data loads an attachment from a path
     rsAtt.Fields("FileData").LoadFromFile (strPath)
    rsAtt.Update
  rsAll.Update
End Sub
Public Sub SaveAllAttachmentsToFile(rsAll As DAO.Recordset, attachmentFieldName As String, Optional SavePath As String = "")
  'An attachment field has a recordset of attachments stored behind the scenes
  Dim rsAtt As DAO.Recordset
  Dim fileName As String
 
  If SavePath = "" Then SavePath = CurrentProject.Path & "\"
  If Right(SavePath, 1) <> "\" Then SavePath = SavePath & "\"
  If Not (rsAll.BOF And rsAll.EOF) Then rsAll.MoveFirst
  Do While Not rsAll.EOF  'Recordset of all records
    Set rsAtt = rsAll.Fields(attachmentFieldName).Value
    Do While Not rsAtt.EOF
       fileName = rsAtt.Fields("FileName").Value
       If Dir(SavePath & fileName) <> "" Then ' the file already exists--delete it first.
          If MsgBox("File already exists. Do you want to overwrite?", vbYesNo, "Overwrite?") = vbYes Then
             VBA.SetAttr SavePath & fileName, vbNormal ' remove any file attributes (e.g. read-only) that would block the kill command.
             VBA.Kill SavePath & fileName ' delete the file.
             rsAtt.Fields("FileData").SaveToFile (SavePath & fileName)
             'Print and delete
              ExecuteFile SavePath & fileName, PrintFile
              VBA.Kill SavePath & fileName
          End If
       Else
         rsAtt.Fields("FileData").SaveToFile (SavePath & fileName)
         'Print and delete
          ExecuteFile SavePath & fileName, PrintFile
          VBA.Kill SavePath & fileName
       End If
       rsAtt.MoveNext
     Loop 'The recordset of attachments for a record
       Exit Sub
       rsAll.MoveNext
   Loop 'The complete recordset
End Sub
 

Mike Krailo

Well-known member
Local time
Today, 04:35
Joined
Mar 28, 2020
Messages
1,030
I was thinking to zip up all the necessary files into one file attachment. Then I just need to extract that one file and unzip it. I'm trying to figure out how your code works to accomplish that.
 

MajP

You've got your good things, and you've got mine.
Local time
Today, 04:35
Joined
May 21, 2018
Messages
8,463
See working demo. Does it all. Checks if files exists, handles security issue on js which is not a supported attachment, downloads files and folders, renames .js file, removes files on exit.
 

Attachments

  • HTMLcolorPicker_MajP.accdb
    580 KB · Views: 379

MajP

You've got your good things, and you've got mine.
Local time
Today, 04:35
Joined
May 21, 2018
Messages
8,463
Although that may sound like a lot, the code to do this is really pretty short. This is even with the additional code of saving the .js file as a .j file, then renaming it. And there are even other bells and whistles for asking the user if they want to save and delete the files. And it handles the case if the user chooses to leave the files or delete the files when done. So this could be shortened even more.

Code:
Private FolderToRemove As String
Public Function SaveColorAttachments()
  Dim rs As DAO.Recordset
  Set rs = CurrentDb.OpenRecordset("tblColorPicker")
 
  SaveColorAttachmentsToFolder rs, "attachField"
 
End Function

Public Sub SaveColorAttachmentsToFolder(rsAll As DAO.Recordset, attachmentFieldName As String, Optional SavePath As String = "")
  'An attachment field has a recordset of attachments stored behind the scenes
  Dim rsAtt As DAO.Recordset
  Dim fileName As String
  Dim TempPath As String
  Dim fso As New FileSystemObject
  Dim rtn As Long
  If SavePath = "" Then SavePath = CurrentProject.Path & "\"
  If Right(SavePath, 1) <> "\" Then SavePath = SavePath & "\"
  SavePath = SavePath & "HTML\"
  FolderToRemove = SavePath
  If Not fso.FolderExists(SavePath) Then
    rtn = MsgBox("The HTML Color Picker Files are not saved to your disk.  Do you want to save?", vbYesNo, "Save Color Picker?")
    If rtn = vbNo Then Exit Sub
    fso.CreateFolder SavePath
  End If
  If Not (rsAll.BOF And rsAll.EOF) Then rsAll.MoveFirst
  Do While Not rsAll.EOF  'Recordset of all records
    
    Set rsAtt = rsAll.Fields(attachmentFieldName).Value
    
    Do While Not rsAtt.EOF
       fileName = rsAtt.Fields("FileName").Value
       'can not store a .js file for security so I removed the s and saved as .j
       'If Right(fileName, 2) = ".j" Then fileName = fileName & "s"
       Select Case fileName
       Case "Index.html"
         TempPath = SavePath
       Case "Themes.css"
         TempPath = SavePath & "CSS\"
       Case "Colorpicker.j"
         TempPath = SavePath & "JS\"
       End Select
       'Debug.Print fileName
      
       If Dir(TempPath & fileName) = "" Then ' the file does not already exist.
          
          If Not fso.FolderExists(TempPath) Then  'first create path
          '   Debug.Print TempPath
             fso.CreateFolder TempPath
          End If
         ' Debug.Print TempPath & fileName
          rsAtt.Fields("FileData").SaveToFile (TempPath & fileName)
          'Try to rename the .j file to js
          If Right(fileName, 2) = ".j" Then
            'rename if not already a .js file
            If Dir(TempPath & fileName & "s") = "" Then
              fso.MoveFile TempPath & fileName, TempPath & fileName & "s"
            End If
            'kill the .j file
            If Dir(TempPath & fileName) <> "" Then Kill (TempPath & fileName)
          End If
        End If
       rsAtt.MoveNext
     Loop 'The recordset of attachments for a record
       rsAll.MoveNext
   Loop 'The complete recordset
   MsgBox "Color Picker Downloaded from attachments."
End Sub
Public Sub RemoveColorPickerFiles()
  Dim rtn As Long
  Dim fso As New FileSystemObject

    If fso.FolderExists(FolderToRemove) Then
       rtn = MsgBox("Would you like to remove the color picker files from disk", vbYesNo, "Remove Files?")
       If rtn = vbYes Then
         Debug.Print FolderToRemove
         fso.DeleteFolder Left(FolderToRemove, Len(FolderToRemove) - 1)
         MsgBox "HTML files and folders removed"
       End If
    End If
End Sub
 

Mike Krailo

Well-known member
Local time
Today, 04:35
Joined
Mar 28, 2020
Messages
1,030
That's even better than what I was imagining MajP. Extracting and then turning around and simply removing the files. I think I'll do that on db close though. Very nice work. I'm still learning about attachments but this seems like a very good use for them.

I'll mark this as solved since this is quite a good solution.
 
Last edited:

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 16:35
Joined
May 7, 2009
Messages
19,169
alternative, it does not rely on External file nor much code.
the beauty is, it is in access library:
Code:
#If Win64 Then
 
    Declare PtrSafe Sub ChooseColor Lib "msaccess.exe" Alias "#53" _
      (ByVal hwnd As Long, rgb As Long)
#Else
 
    Declare Sub ChooseColor Lib "msaccess.exe" Alias "#53" _
      (ByVal hwnd As Long, rgb As Long)
#End If

Public Function colorPicker() As Long
    Static lngColor As Long
    ChooseColor Application.hWndAccessApp, lngColor
    colorPicker = lngColor
End Function
 

Mike Krailo

Well-known member
Local time
Today, 04:35
Joined
Mar 28, 2020
Messages
1,030
I'll check that out Arnel. I'm always interested in the alternatives. Thanks for pointing out that option as well.
 

Users who are viewing this thread

Top Bottom