Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Chris Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Textbox control path - check directory exists? 2

Status
Not open for further replies.

misscrf

Technical User
Jun 7, 2004
1,344
US
This is related to another thread on having a continuous form with checkbox control to select records, transpose each one and save to a csv. That is here: thread702-1678266

Now I am trying to make it so that I don't have to have a prompt for the path, everytime we go to make these files in a given project.

I created a new table called tblCustomPaths. It has a PK ID field, a field for the project ID, and the path.

What I want to do is have a text box control on the header for the path to be entered. It will actually be bound to that path column in the tblCustomPaths table. The after event of that text box (or change) would be set to the combo row/source filter that is also in the header of this form.

I am still working through that setup. The issue at the moment, is that I need to run some checks when the command button is clicked to cycle through the checked items and make the csv files.

I need to check that text box and if it is empty - msgbox to say "need to fill a path" and cancel event. If the directory doesn't exist, create it, if all is good, go do the loop.

I have the code below, but I get an error "Object Required". I have also gotten file/access error, but not getting that right now.

found this online:
Code:
Function FileExistsDIR(sFile As String) As Boolean
FileExistsDIR = True
If Dir$(sFile) = vbNullString Then FileExistsDIR = False
End Function

This is my code, which I got some help from the awesome people on this forum:
Code:
Private Sub cmdGenerateProjectMetadata_Click()
On Error GoTo Err_cmdGenerateProjectMetadata_Click

Dim strDoc As String
Dim strFileName As String
Dim strPath As String
Dim strExportFile As String
Dim rs As DAO.Recordset
Set rs = Me.Recordset
Dim bExists As Boolean

bExists = FileExistsDIR("path")

If Me.CustomPath = "" Then
    MsgBox "You must enter a valid UNC path into the Custom Metadata Path, for files to be generated!!!", vbCritical, "Where am I putting the metadata?"
    DoCmd.CancelEvent
ElseIf Me.CustomPath Is Null Then
    MsgBox "You must enter a valid UNC path into the Custom Metadata Path, for files to be generated!!!", vbCritical, "Where am I putting the metadata?"
    DoCmd.CancelEvent
Else
    strPath = Me.CustomPath & "\"
End If

If bExist = False Then
'create directory
    MkDir strPath
End If

rs.MoveFirst
For i = 1 To rs.RecordCount
    If Me.GenerateMetadatatmp.Value = True Then
        strDoc = "qryUnionCustomMetadata"
            strFileName = Forms![frmProcessingTracking].Form![ProjectEvidenceFileBatch]
            strExportFile = strPath & strFileName & ".csv"
            MsgBox strExportFile
            ' This will not over write a file that already exists!  Comment out to over write files!
            If Not FileExists(strExportFile) Then
            'Keep the next line no matter what
                DoCmd.TransferText acExportDelim, , strDoc, strExportFile, False
            ' This will not over write a file that already exists!  Comment out to over write files!
            End If
    End If
rs.MoveNext
Next i

DoCmd.SetWarnings False
strSql = "UPDATE tblDiscoveryProcessing SET GenerateMetadatatmp = 0;"
DoCmd.RunSQL strSql
Me.Requery
DoCmd.SetWarnings True
MsgBox "All custom Metadata has been generated", vbOKOnly, "Custom Metadata Generated"
   
Exit_cmdGenerateProjectMetadata_Click:
    Exit Sub
Err_cmdGenerateProjectMetadata_Click:
    MsgBox Err.Description
    Resume Exit_cmdGenerateProjectMetadata_Click
End Sub

Can anyone help me with this, please?

misscrf

It is never too late to become what you could have been ~ George Eliot
 
You're a genius!!! Why can't I give you 20 stars for this thread??? lol I am going to do some cleaning up and then I will post the final code.

Hopefully no more road bumps!!


Thank you both so much for responding and helping me out.

misscrf

It is never too late to become what you could have been ~ George Eliot
 
Here is the final code. It would probably be cool to make an FAQ out of this at some point. Thank you again for all the help. I wouldn't have gotten to this point with out you amazing people on this site. :-D

Code:
Function FileExists(ByVal strFile As String, Optional bFindFolders As Boolean) As Boolean
    'Purpose:   Return True if the file exists, even if it is hidden.
    'Arguments: strFile: File name to look for. Current directory searched if no path included.
    '           bFindFolders. If strFile is a folder, FileExists() returns False unless this argument is True.
    'Note:      Does not look inside subdirectories for the file.
    'Author:    Allen Browne. [URL unfurl="true"]http://allenbrowne.com[/URL] June, 2006.
    Dim lngAttributes As Long

    'Include read-only files, hidden files, system files.
    lngAttributes = (vbReadOnly Or vbHidden Or vbSystem)

    If bFindFolders Then
        lngAttributes = (lngAttributes Or vbDirectory) 'Include folders as well.
    Else
        'Strip any trailing slash, so Dir does not look inside the folder.
        Do While Right$(strFile, 1) = "\"
            strFile = Left$(strFile, Len(strFile) - 1)
        Loop
    End If

    'If Dir() returns something, the file exists.
    On Error Resume Next
    FileExists = (Len(Dir(strFile, lngAttributes)) > 0)
End Function

-------------------------------------------------
Code:
Function FileExistsDIR(sFile As String) As Boolean
FileExistsDIR = True
If Dir(sFile, vbDirectory) = vbNullString Then FileExistsDIR = False
End Function

-------------------------------------------------
Code:
Private Sub cmdGenerateProjectMetadata_Click()
'On Error GoTo Err_cmdGenerateProjectMetadata_Click

Dim strDoc As String
Dim strFileName As String
Dim strPath As String
Dim strExportFile As String
Dim rs As DAO.Recordset
Set rs = Me.Recordset
Dim bExists As Boolean
Dim intChecks As Integer
Dim intSetPathResp As Integer
Dim intMakePathResp As Integer
Dim intNoPathResp As Integer
Dim intConfirmPathResp As Integer
Dim intOvrWrtResp As Integer

'If there is no filter on the form, then issue a message.  The filter value is used for the path value dlookup.  it must be set to continue
If Me.FilterOn = False Then
    MsgBox "Processing form must have an active filter, in order to run custom metadata.", vbCritical, "Please choose a filter and try again."
    Exit Sub
End If

'Save records in case someone checked a box, but didn't actually leave the record
RunCommand acCmdSaveRecord
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
Me.Refresh
Me.Dirty = False

'If no records are checked, issue a message and cancel the event
intChecks = Abs(DCount("GenerateMetadataTmp", "tblDiscoveryProcessing", "GenerateMetadataTmp = -1"))
If intChecks = 0 Then
    MsgBox "No records are checked for custom metadata generation.", vbCritical, "Please check the check box for each record to be generated."
    Exit Sub
End If

'Set the variable string for the path to a dlook up of the project's set metadata path
strPath = DLookup("[CustomPath]", "tblMetadataPaths", "[AssetMatter] =  '" & Me.cboAssetMatterFilter.Column(0) & "'")

'If the path record does not exist in the path table, a message box to ask if a form should be opened to enter in an export path
If strPath = "" Then
    intSetPathResp = MsgBox("No metadata path has been set for this project.  A form will be opened.  Please fill out a new record with this project's matter and the path.", vbYesNo, "Where am I putting the metadata?")
    'If the user says yes to open a form so that a path can be entered - open the form
    If intSetPathResp = vbYes Then
        DoCmd.OpenForm "frmProjectMetadataPaths", acNormal, , , , acDialog
        Me.Visible = False
    'If the user says no, issue a message saying a path is needed, and cancel the event
    ElseIf intSetPathResp = vbNo Then
        MsgBox "Generate custom metadata has been cancelled.", vbCritical, "Must have a path to save files to."
        Exit Sub
    End If
'If the path record exists in the path table, set the path variable to the path from the path table
Else
    strPath = DLookup("[CustomPath]", "tblMetadataPaths", "[AssetMatter] =  '" & Me.cboAssetMatterFilter & "'") & "\"
End If

'Issue the FileExistsDIR function to check if the path in the path table exists
bExists = FileExistsDIR(strPath)

'If there is a path in the path table, but that path does not exist in Windows
If bExists = False Then
    'Issue a message box to ask if it should be created
    intMakePathResp = MsgBox("The directory " & strPath & " does not exist not exist.  Would you like me to create it?", vbYesNo, "Custom Path Does Not Exist")
    'If the response is yes, make the path folder - THIS WILL ONLY MAKE THE BOTTOM LEVEL SUB FOLDER.  IT WILL NOT CREATE EVERY FOLDER IN THE PATH.
    If intMakePathResp = vbYes Then
        MkDir strPath
    'If the response to make the directory is answered no
    ElseIf intMakePathResp = vbNo Then
        'Issue a message to ask if the path form should be opened, so that the path can be edited/revised
        intNoPathResp = MsgBox("You answered that you do not want to make a new path.  Would you like to edit this projects existing path?", vbYesNo, "Must have a path to save files to.")
        'If the response is yes - open the path form (DIALOG - pauses the code) and make the main form hidden
        If intNoPathResp = vbYes Then
            DoCmd.OpenForm "frmProjectMetadataPaths", acNormal, , , , acDialog
            Me.Visible = False
        'If the response is no - to not open the form and revise the path
        ElseIf intNoPathResp = vbNo Then
            'Issue a message box that the command has ultimately been canceled, and cancel the event
            MsgBox "There is a path set for this project, but it does not exist.  You do not want it created, or to revise the path." & _
            "Generating metadata has been cancelled", "vbCritical", "Must have a path to save files to."
            Exit Sub
        End If
    End If
End If

'The path exists is not false, issue a message box with the path that the files will be exported to, for confirmation
intConfirmPathResp = MsgBox("The selected records will now be exported to this path: " & strPath, vbOKCancel, "Click Cancel To Edit the Path")
    'If Cancel is chosen, open the path form to edit the path
    If intConfirmPathResp = vbCancel Then
        MsgBox "The metadata form will now open for you to edit the path", vbOKOnly, "Edit Export Path"
        DoCmd.OpenForm "frmProjectMetadataPaths", acNormal, , , , acDialog
        Me.Visible = False
        Exit Sub
    End If
    
'The path being confirmed, begin to loop through the checked records on the continous form
rs.MoveFirst
For i = 1 To rs.RecordCount
        If Me.GenerateMetadatatmp.Value = True Then
                strDoc = "qryUnionCustomMetadata"
                strFileName = Forms![frmProcessingTracking].Form![ProjectEvidenceFileBatch]
                strExportFile = strPath & strFileName & ".csv"
                'Ask if file should be overwritten
                If Not FileExists(strExportFile) Then
                    'keep the next line no matter what
                    DoCmd.TransferText acExportDelim, , strDoc, strExportFile, False
                Else
                    intOvrWrtResp = MsgBox("The File " & strFileName & ".csv" & " Already Exists.  Would you like me to overwrite it?", vbYesNo, "File Exists")
                    'If the response is yes, overwrite the metadata file.
                    If intOvrWrtResp = vbYes Then
                        DoCmd.TransferText acExportDelim, , strDoc, strExportFile, False
                    'Otherwise, skip this record (don't do the command, just move on to the move next)
                    ElseIf intOvrWrtResp = vbNo Then
                    End If
                End If
        End If
    rs.MoveNext

Next i

'Set the warnings false
DoCmd.SetWarnings False
'Update all records to uncheck the temporary checkboxed used for selecting records for export
strSql = "UPDATE tblDiscoveryProcessing SET GenerateMetadatatmp = 0;"
DoCmd.RunSQL strSql
Me.Requery
'Turn warnings back on and issue a message to let the user know all the work is done
DoCmd.SetWarnings True
MsgBox "All custom Metadata has been generated", vbOKOnly, "Custom Metadata Generated"
   
Exit_cmdGenerateProjectMetadata_Click:
    Exit Sub
Err_cmdGenerateProjectMetadata_Click:
    MsgBox Err.Description
    Resume Exit_cmdGenerateProjectMetadata_Click
End Sub

misscrf

It is never too late to become what you could have been ~ George Eliot
 
Oops! I just deployed this and when a user went to run this on a project that has no path, he got a an error "invalid use of null"

It goes back to the setting of the strpath:

Code:
strPath = DLookup("[CustomPath]", "tblMetadataPaths", "[AssetMatter] =  '" & Me.cboAssetMatterFilter.Column(0) & "'")

What am I missing here? When I debug and hover over strpath, it shows strPath = ""

when I debug print, I get a blank line (it is emtpy) I don't get what I am doing wrong to set this variable to a dlookup. In this scenario, we are looking for a record, and finding that there is no record in the table for this criteria, which is the answer we are looking for, to tell us to prompt the user to go make set the path (create the record).



misscrf

It is never too late to become what you could have been ~ George Eliot
 
Grrr. I got it.

strPath = Nz(DLookup("[CustomPath]", "tblMetadataPaths", "[AssetMatter] = '" & Me.cboAssetMatterFilter.Column(0) & "'"))

misscrf

It is never too late to become what you could have been ~ George Eliot
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top