Automate file dialog process (1 Viewer)

Alhakeem1977

Registered User.
Local time
Today, 05:25
Joined
Jun 24, 2017
Messages
308
Hi,

The code below is working perfectly to upload pdf files to a predefined folder in our local network.

1. How can I get the user confirmation to overwrite the existing file with the same name in the uploading process?
2. How can I auto rename the uploaded file to the field [RefID] automatically?
3. How can I show "Open" key word inserted of the file path? i.e. to replace the file path with another word.

Code:
Private Sub Command201_Click()
On Error GoTo err
Dim i As Integer
Dim sPath As String
Dim sFile As String
Dim Fol As Object, DoneFiles As String
DoneFiles = "Files Uploaded are: "
Set Fol = Application.FileDialog(3)
Fol.AllowMultiSelect = False
If Fol.Show Then
    For i = 1 To Fol.SelectedItems.Count
        sFile = Filename(Fol.SelectedItems(i), sPath)
        If Dir("D:\AttachmentsCustService\" & sFile) & "" = "" Then           'Insure if the file exist
            FileCopy sPath & sFile, "D:\AttachmentsCustService\" & sFile
            DoneFiles = DoneFiles & vbCrLf & i & " - " & sFile
            Att = "D:\AttachmentsCustService\" & sFile
        Else
            MsgBox "This file already exist: " & vbCrLf & sFile & ""
            If i > 1 Then MsgBox DoneFiles '      ' Mesgbox of the files uploaded
            Exit Sub
        End If
    Next
End If
Exit Sub
err:
MsgBox "An error Occoured while uploading"
End Sub
 
Last edited:

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 10:25
Joined
May 7, 2009
Messages
19,169
Code:
Private Sub Command201_Click()
On Error GoTo err
Dim i As Integer
Dim sPath As String
Dim sFile As String
Dim sNew As String
Dim Fol As Object, DoneFiles As String
DoneFiles = "Files Uploaded are: "
Set Fol = Application.FileDialog(3)
Fol.AllowMultiSelect = False
If Fol.Show Then
    For i = 1 To Fol.SelectedItems.count
        sFile = FileName(Fol.SelectedItems(i), sPath)
        If Dir("D:\AttachmentsCustService\" & sFile) & "" = "" Then           'Insure if the file exist
            FileCopy sPath & sFile, "D:\AttachmentsCustService\" & sFile
            DoneFiles = DoneFiles & vbCrLf & i & " - " & sFile
            Att = "D:\AttachmentsCustService\" & sFile
        Else
            sNew = fnkRename(sFile, "D:\AttachmentsCustService\")
            If MsgBox("This file already exist: " & vbCrLf & sFile & vbCrLf & vbCrLf & _
                "Do you want to copy it as: " & sNew, vbQuestion + vbYesNo) = vbYes Then
                FileCopy sPath & sFile, "D:\AttachmentsCustService\" & sNew
                DoneFiles = DoneFiles & vbCrLf & i & " - " & sNew
                Att = "D:\AttachmentsCustService\" & sNew
            Else
                If i > 1 Then
                    MsgBox DoneFiles '      ' Mesgbox of the files uploaded
                    Exit Sub
                End If
            End If
        End If
    Next
End If
Exit Sub
err:
MsgBox "An error Occoured while uploading"
End Sub


Public Function fnkRename(sFile As String, sPath As String) As String

    Dim sExt As String
    Dim i As Integer
    Dim sNew As String
    
    sPath = Replace(sPath & "\\", "\")
    sExt = Mid(sFile, InStrRev(sFile, "."))
    sFile = Replace(sFile, sExt, "")
    
    sNew = sFile & sExt
    While Dir(sPath & sNew) <> ""
        i = i + 1
        sNew = sFile & "(" & i & ")" & sExt
    Wend
    
    fnkRename = sNew
                
End Function
 

Alhakeem1977

Registered User.
Local time
Today, 05:25
Joined
Jun 24, 2017
Messages
308
Thank you so much.

But just to clarify the function should be kept in the same form or in a separate Module?

I will check and I let you know the result.

Sent from my HUAWEI NXT-L29 using Tapatalk
 

Alhakeem1977

Registered User.
Local time
Today, 05:25
Joined
Jun 24, 2017
Messages
308
Hi arnelgp,

I've got an error highlights the Replace keyword and says: "Argument not optional".
 

Attachments

  • error.PNG
    error.PNG
    28.4 KB · Views: 261
Last edited:

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 10:25
Joined
May 7, 2009
Messages
19,169
Debug->Compile your code, there maybe other errors.
 

Alhakeem1977

Registered User.
Local time
Today, 05:25
Joined
Jun 24, 2017
Messages
308
Debug->Compile your code, there maybe other errors.
Hi, I compiled the code it's highlights the Replace function as shown in my previous post.

Sent from my HUAWEI NXT-L29 using Tapatalk
 

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 10:25
Joined
May 7, 2009
Messages
19,169
check the Reference if you are missing any.
 

Alhakeem1977

Registered User.
Local time
Today, 05:25
Joined
Jun 24, 2017
Messages
308
check the Reference if you are missing any.

Dear arneldp I am still strugling I did not get it solved.:banghead:


I have attached my database if you could solve the issue but before that, you have to create a folder on your D drive then open the database and click the New Case button and try to enter one record and attach a pdf file to it then try to attach the same file (it should overwrite the previous file and thats what I want to achieve).

Thank you so much for your always support!:)
 

Attachments

  • Workflow Forms Management.accdb
    1.8 MB · Views: 255
Last edited:

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 10:25
Joined
May 7, 2009
Messages
19,169
here test this.
 

Attachments

  • Workflow Forms Management.accdb
    1.8 MB · Views: 256

Alhakeem1977

Registered User.
Local time
Today, 05:25
Joined
Jun 24, 2017
Messages
308
here test this.
Thank you so much, I do not know how to thank you.

But I do not know if it's possible to rename the selected file as a form field [RefID]?
Otherwise your amendments are meet my aim.

Thanks a lot!

Sent from my HUAWEI NXT-L29 using Tapatalk
 

Users who are viewing this thread

Top Bottom