OOPS! Sorry, there is a problem with that code ... fixing it now ...
hi Art,
you're welcome ~
"load all the files ... into a subform "
Subforms don't have data, they have controls. Data is stored in tables.
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'here is some code to write to a table called MyFiles
'read the comments to get more information
'
Sub callLoopFilesAndStore()
's4p 170518
'customize path and, optionally specify second paramter for filemask to look for
Call LoopFilesAndStore("c:\path")
'for instance:
' Call LoopFilesAndStore("H:\MyFolder", "*.pdf")
End Sub
Sub LoopFilesAndStore( _
ByVal psPath As String _
, Optional psMask As String = "*.*")
's4p 170518, 170802
'store file information in a table called MyFiles with:
' File_Name, string, File Name
' File_Size, Long, File Size in Bytes
' File_Path, string, File Path
' File_Modify, date/time, date/time file was modified
' BatchID, Long, is to mark this batch of files 'could be FK for another table
'PARAMETERS
' psPath is path to look in
' psMask is what to look for (*.*, *.jpg, *.pdf, *.zip, ...)
On Error GoTo Proc_Err
Dim sPathFile As String _
, sFilename As String _
, sLookFor As String _
, sAllFiles As String _
, sMsg As String _
, sSql As String _
, i As Integer _
, nMaxID As Long
Dim arrFile() As String
Dim db As DAO.Database _
, rs As DAO.Recordset _
, rsMax As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("MyFiles", dbOpenDynaset, dbAppendOnly)
If Right(psPath, 1) <> "\" Then
psPath = psPath & "\"
End If
sLookFor = psPath & psMask
'get the first filename
'attributes could be specified -- lookup Help for Dir
sFilename = Dir(sLookFor)
'make sure something was found
If sFilename = "" Then
'see if the path is valid
sFilename = Dir(psPath, vbDirectory)
If sFilename = "" Then
MsgBox psPath & " is not a valid path " _
, , "Path not Valid"
Else
MsgBox "No files found in " & psPath _
& vbCrLf & "for " & psMask _
, , "No Files"
End If
GoTo Proc_Exit
End If
'store file names from specified path into string
sAllFiles = sFilename
'save path\file to test to make sure it is not a folder
sPathFile = psPath & sFilename
'load files matching mask into an array
Do While sFilename <> ""
If (GetAttr(sPathFile) And vbDirectory) <> vbDirectory Then
'add filename to string of all filenames
'delimit with ;
sAllFiles = sAllFiles & ";" & sFilename
End If
'get next filename
sFilename = Dir()
sPathFile = psPath & sFilename
Loop
'convert string of all filenames to array
arrFile = Split(sAllFiles, ";")
'stop if no files found
If Not UBound(arrFile) >= 0 Then
MsgBox "Only folders found in " & psPath _
& vbCrLf & "for " & psMask _
, , "No Files"
GoTo Proc_Exit
End If
'get maximum BatchID (ideally this would be passed)
sSql = "SELECT nz(Max(BatchID),1) as MyMaxID " _
& " FROM MyFiles;"
Set rsMax = db.OpenRecordset(sSql, dbOpenSnapshot)
If rsMax.EOF Then
nMaxID = 1
Else
nMaxID = rsMax!MyMaxID + 1
End If
rsMax.Close
Set rsMax = Nothing
With rs
'loop through specified files and store information
For i = LBound(arrFile) To UBound(arrFile)
sPathFile = psPath & arrFile(i)
.AddNew
!File_Name = arrFile(i)
!File_Path = psPath
!File_Size = FileLen(sPathFile)
!File_Modify = FileDateTime(sPathFile)
!BatchID = nMaxID
.Update
Next i
.Close
End With 'rs
Set rs = Nothing
Set db = Nothing
'number of files
i = UBound(arrFile) - LBound(arrFile) + 1
DoCmd.openTable "MyFiles"
MsgBox i & " Files loaded from " _
& psPath _
, , "LoopFilesAndStore Done"
Proc_Exit:
On Error Resume Next
'release/close/quit object variables
If Not rsMax Is Nothing Then
rsMax.Close
Set rsMax = Nothing
End If
If Not rs Is Nothing Then
rs.Close
Set rs = Nothing
End If
Set db = Nothing
Exit Sub
Proc_Err:
sMsg = psPath & vbCrLf & vbCrLf
If Err.Number = 52 Then
sMsg = sMsg & "Drive is empty" & vbCrLf & vbCrLf
End If
MsgBox sMsg & Err.Description, , _
"ERROR " & Err.Number _
& " LoopFilesAndStore "
Resume Proc_Exit
Resume
End Sub
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
respectfully,
crystal
~ have an awesome day ~
On 8/1/17 9:25 PM, Art Lorenzini dbalorenzini@yahoo.com [MS_Access_Professionals] wrote:
Between yours and Crystals help I have a functional folder hierarchy creator.... Thank you that was a huge step. Now the next step is the user step through a series of combo boxes to get to the folder that they want now I need to load all the files located in the specified folder into a subform called sfrmFiles...
With Warm Regards,Arthur D. LorenziniIT System ManagerCheyenne River Housing AuthorityWk.(605)964-4265 Ext. 130Fax (605)964-1070
"Valar Dohaeris"
On Monday, July 31, 2017 02:26:26 PM, 'Graham Mandeno' graham@mandeno.com [MS_Access_Professionals] <MS_Access_Professionals@yahoogroups.com> wrote:
OK, I understand. God bless "Management" :-)
The next question then, is "Do you want to duplicate the hierarchy of folder and file names in the Access database (and risk it getting out of sync every time a file is added or deleted) or do you want to populate the combo/list boxes directly from the folder structure?
Best wishes,
Graham
From: MS_Access_Professionals@yahoogroups.com [mailto:MS_Access_Professionals@yahoogroups.com]
Sent: Tuesday, 1 August 2017 01:27
To: 'Graham Mandeno' graham@mandeno.com [MS_Access_Professionals] <MS_Access_Professionals@yahoogroups.com>
Subject: Re: RE: [MS_AccessPros] Creating a folder structure based on combos?
Yes, that is what the Management wants...
With Warm Regards,
Arthur D. Lorenzini
IT System Manager
Cheyenne River Housing Authority
Wk.(605)964-4265 Ext. 130
Fax (605)964-1070
"Anyone who claimed that old age had brought them patience was either lying or senile."
On Sun Jul 30 2017 17:23:08 GMT-0500 (Central Daylight Time), 'Graham Mandeno' graham@mandeno.com [MS_Access_Professionals] <MS_Access_Professionals@yahoogroups.com> wrote:
Hi Art
I can't help but think you are trying to reinvent the Windows File Explorer!
Is there any compelling reason to reproduce the file system folder/document hierarchy in Access?
Best wishes,
Graham
From: MS_Access_Professionals@yahoogroups.com [mailto:MS_Access_Professionals@yahoogroups.com]
Sent: Monday, 31 July 2017 03:40
To: MS_Access_Professionals@yahoogroups.com
Subject: [MS_AccessPros] Creating a folder structure based on combos?
Currently writing a document management system in Access and would like to know if the following is possible:
I have my home screen called frmMain. On this form I have a cboCabinet (unbound - row source: SELECT tblCabinet.intCabinetID, tblCabinet.txtCabinetName, tblCabinet.txtCabinetLocation FROM tblCabinet; ) which is at the highest level of the hierarchy.
Then is the combo cboDrawer (unbound - row source:SELECT tblDrawer.intDrawerID, tblDrawer.intCabinetID, tblDrawer.txtDrawerName, tblDrawer.txtDrawerLocation FROM tblDrawer; which is the secondary level of the hierarchy.
Thirdly is my combobox cboPriFolder (unbound - row source: SELECT tblPrimaryFolder.intPriFolderID, tblPrimaryFolder.intDrawerID, tblPrimaryFolder.txtPriFolderName, tblPrimaryFolder.txtPriFolderLocation FROM tblPrimaryFolder; which is the tertiary level of the folder hierarchy.
Lastly is my listbox called lstSubFolder (unbound - rowsource:SELECT tblSubFolder.intSubFolderID, tblSubFolder.txtSubFolderName, tblSubFolder.intPriFolderID FROM tblSubFolder; This is the last level of the folder hierarchy.
on frmMain, this combination of combos and lstboxes is used to set the working folder.
So the following actions need to happen:
1. the root of the folder hierarchy is always c:\work but it could be mapped out to a server drive
2. I have a frmCabinets which the user use to create the folder hierarchy. At this point I need to the mechanics to create the actual folder structure based on the combination of combos and list boxes. ( I have uploaded a few snapshots of what frmMain and frmCabinets look like to the Needs Assistance folder.
3. Once the user sets the working folder, then I need to display a list of files in that folder. The user should be able to open any file in its natural application.
4. The application will need to remember the last selection in the combos and listboxes and working directory each time the user logs off and logs back in.
I know its a lot and as I go along I suspect I will have a lot more questions....
Thank you,
Art Lorenzini
Sioux Falls, SD
Ps. pictures will be uploaded shortly.
Posted by: crystal 8 <strive4peace2008@yahoo.com>
| Reply via web post | • | Reply to sender | • | Reply to group | • | Start a New Topic | • | Messages in this topic (9) |
Tidak ada komentar:
Posting Komentar