Alert message for duplication of a file

I

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
5,738
Office Version
  1. 2007
Platform
  1. Windows
Morning,
I have the following supplied code which i run after i have printed an invoice.
It saves a word invoice to the folder mentioned & informs me with a message box once done.

Could you advise a edit where it will only allow the save to go ahead if that invoice number does not exist.
I mean if there is an invoice number 100 already show msg box otherwise continue and save.
Just a back up so i dont overwrite an existing file.


Code: 
Private Sub Clear_Invoice_After_Printing_Click()    
    Dim objWord As New Word.Application
    'Copy the range Which you want to paste in a New Word Document as a screenshot
    Dim strFileName As String
    strFileName = "C:\Users\Ian\Desktop\REMOTES ETC\DR COPY INVOICES\Invoice " & Range("N4").Value & " " & Format(Now, "dd-mm-yyyy") & ".doc"
    Range("G3:O60").CopyPicture xlPrinter
    With objWord
        With .Documents.Add
            .Parent.Selection.Paste
            .SaveAs strFileName
            .Close
        End With
        '.Visible = True
        .Quit
    End With
    MsgBox strFileName, vbInformation, "Invoice Saved as Screenshot  Word.doc"
    
    
    Range("G13:I18").ClearContents
    Range("N14:O18").ClearContents
    Range("G27:N42").ClearContents
    Range("G13:I13").ClearContents
    Range("G49:I49").ClearContents
    Range("G48:I48").ClearContents
    Range("G47:I47").ClearContents
    Range("G46:I46").ClearContents
    Range("G45:I45").ClearContents
    Range("N4").Value = Range("N4").Value + 1
    Worksheets("INV 2").Range("N4").Value = Range("N4").Value
    Range("G13").Select
    ActiveWorkbook.Save
    
End Sub

Many thanks
 

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.
Sort by date Sort by votes
Use the Dir function to check whether the file exists. See if you can incorporate the following into your code:
Code: 
    If Dir(strFileName) <> vbNullString Then
        MsgBox strFileName & " already exists"
    Else
        'Code here to save new file
        
    End If
 
Upvote 0
Morning all,
Ive been looking at the above suggested code and placed it within my original working code as supplied below.
When i have a receipt lets say 100 and i try and save another receipt 100 as opposed to the code advising me the File Already Exists it saves another receipt,actually it just overwrites the existing 100 receipt and saves this 100 receipt no problem.
I mean i am not alerted that the file already exists & i see no error message to advise me of this.
Can you advise the correct placement please of the code so i am advised of a receipt of the same number exists & not to overwrite the existing receipt..

Many thanks & have a nice day.


Code: 
Private Sub Clear_Invoice_After_Printing_Click()    
    Dim objWord As New Word.Application
    'Copy the range Which you want to paste in a New Word Document as a screenshot
    Dim strFileName As String
    strFileName = "C:\Users\Ian\Desktop\REMOTES ETC\DR COPY INVOICES\Invoice " & Range("N4").Value & " " & Format(Now, "dd-mm-yyyy") & ".doc"
    Range("G3:O60").CopyPicture xlPrinter
        If Dir(strFileName) <> vbNullString Then
        MsgBox strFileName & " already exists"
    Else
        'Code here to save new file
            With objWord
        With .Documents.Add
            .Parent.Selection.Paste
            .SaveAs strFileName
            .Close
        End With
        '.Visible = True
        .Quit
    End With
    MsgBox strFileName, vbInformation, "Invoice Saved as Word.doc"
    
    
    Range("G13:I18").ClearContents
    Range("N14:O18").ClearContents
    Range("G27:N42").ClearContents
    Range("G13:I13").ClearContents
    Range("G49:I49").ClearContents
    Range("G48:I48").ClearContents
    Range("G47:I47").ClearContents
    Range("G46:I46").ClearContents
    Range("G45:I45").ClearContents
    Range("N4").Value = Range("N4").Value + 1
    Worksheets("INV 2").Range("N4").Value = Range("N4").Value
    Range("G13").Select
    ActiveWorkbook.Save
    End If
   
End Sub
 
Upvote 0
Your code looks correct. Could there be leading or trailing spaces in the N4 cell value which aren't present in the file name? That could cause the code to think the file doesn't exist. Is the dd-mm-yyyy date correct? Is the ".doc" part correct? Maybe it should be ".docx", which is the default Word file type from Word 2007.

Try this test code which uses the Trim function to remove leading and trailing spaces from the N4 value when it is used in the strFileName variable, displays the N4 cell value, then displays whether the file exists or not.

Code: 
Sub Test()

    Dim strFileName As String
    strFileName = "C:\Users\Ian\Desktop\REMOTES ETC\DR COPY INVOICES\Invoice " & Trim(Range("N4").Value) & " " & Format(Now, "dd-mm-yyyy") & ".doc"
    MsgBox "N4 cell value = >" & Range("N4").Value & "<"
    If Dir(strFileName) <> vbNullString Then
        MsgBox strFileName & " already exists"
    Else
        MsgBox strFileName & " doesn't exist"
    End If

End Sub
 
Upvote 0
The Dir function also accepts wild card inputs to cover several files in your folder. Give the following a try:

Code: 
Private Sub Clear_Invoice_After_Printing_Click()    
    Dim objWord As New Word.Application
    'Copy the range Which you want to paste in a New Word Document as a screenshot
    Dim strFileName As String
[COLOR=#ff0000]    Dim strSearchName As String[/COLOR]
    strFileName = "C:\Users\Ian\Desktop\REMOTES ETC\DR COPY INVOICES\Invoice " & Range("N4").Value & " " & Format(Now, "dd-mm-yyyy") & ".doc"
    [COLOR=#ff0000]strSearchName = "C:\Users\Ian\Desktop\REMOTES ETC\DR COPY INVOICES\Invoice " & Range("N4").Value & "*.doc"[/COLOR]
    Range("G3:O60").CopyPicture xlPrinter
[COLOR=#ff0000]    If Dir(strSearchName) <> vbNullString Then[/COLOR]
        [COLOR=#ff0000]MsgBox "Invoice " & Range("N4").Value & " already exists"[/COLOR]
    Else
        'Code here to save new file
        With objWord
            With .Documents.Add
                .Parent.Selection.Paste
                .SaveAs strFileName
                .Close
            End With
            '.Visible = True
            .Quit
        End With
        MsgBox strFileName, vbInformation, "Invoice Saved as Word.doc"
        
        Range("G13:I18").ClearContents
        Range("N14:O18").ClearContents
        Range("G27:N42").ClearContents
        Range("G13:I13").ClearContents
        Range("G49:I49").ClearContents
        Range("G48:I48").ClearContents
        Range("G47:I47").ClearContents
        Range("G46:I46").ClearContents
        Range("G45:I45").ClearContents
        Range("N4").Value = Range("N4").Value + 1
        Worksheets("INV 2").Range("N4").Value = Range("N4").Value
        Range("G13").Select
        ActiveWorkbook.Save
    End If
   
End Sub
 
Upvote 0
Hi,
I have tried what LockeGarmin advised but it works like before in respect of no error and continues to overwrite.
I have shared a copy of the sheet here.


DR22
 
Last edited:
Upvote 0
First of all, I made a mistake in my previous code so I wanted to at least make this correction.

Code: 
Private Sub Clear_Invoice_After_Printing_Click()
    Dim objWord As New Word.Application
    'Copy the range Which you want to paste in a New Word Document as a screenshot
    Dim strFileName As String
    Dim strSearchName As String
    strFileName = "C:\Users\Ian\Desktop\REMOTES ETC\DR COPY INVOICES\Invoice " & Range("N4").Value & " " & Format(Now, "dd-mm-yyyy") & ".doc"
    strSearchName = "C:\Users\Ian\Desktop\REMOTES ETC\DR COPY INVOICES\Invoice " & Range("N4").Value & [COLOR=#ff0000]" *.doc"[/COLOR]
    Range("G3:O60").CopyPicture xlPrinter
    If Dir(strSearchName) <> vbNullString Then
        MsgBox "Invoice " & Range("N4").Value & " already exists"
    Else
        'Code here to save new file
        With objWord
            With .Documents.Add
                .Parent.Selection.Paste
                .SaveAs strFileName
                .Close
            End With
            '.Visible = True
            .Quit
        End With
        MsgBox strFileName, vbInformation, "Invoice Saved as Word.doc"
        
        Range("G13:I18").ClearContents
        Range("N14:O18").ClearContents
        Range("G27:N42").ClearContents
        Range("G13:I13").ClearContents
        Range("G49:I49").ClearContents
        Range("G48:I48").ClearContents
        Range("G47:I47").ClearContents
        Range("G46:I46").ClearContents
        Range("G45:I45").ClearContents
        Range("N4").Value = Range("N4").Value + 1
        Worksheets("INV 2").Range("N4").Value = Range("N4").Value
        Range("G13").Select
        ActiveWorkbook.Save
    End If
   
End Sub

The code I wrote still seems to be working on my end. I'll post the code that I'm using to test this out below, maybe someone can uncover something that I'm not understanding. When I run the code below once it successfully saves, the second time it shows the message that the invoice already exists. Sorry I couldn't be more helpful. Good luck!

Code: 
Private Sub Clear_Invoice_After_Printing_Click()
    Dim objWord As New Word.Application
    'Copy the range Which you want to paste in a New Word Document as a screenshot
    Dim strFileName As String
    Dim strSearchName As String
    
    'Make a new workbook for test data
    Workbooks.Add.Worksheets(1).Activate
    'Setup Test Data
    Range("G3:O60").Value2 = 1
    'Setup Fake Invoice Number
    Range("N4").Value = 101
    
    strFileName = Environ$("UserProfile") & "\Desktop\Invoice " & Range("N4").Value & " " & Format(Now, "dd-mm-yyyy") & ".doc"
    strSearchName = Environ$("UserProfile") & "\Desktop\Invoice " & Range("N4").Value & " *.doc"
    Range("G3:O60").CopyPicture xlPrinter
    If Dir(strSearchName) <> vbNullString Then
        MsgBox "Invoice " & Range("N4").Value & " already exists"
    Else
        'Code here to save new file
        With objWord
            With .Documents.Add
                .Parent.Selection.Paste
                .SaveAs strFileName
                .Close
            End With
            '.Visible = True
            .Quit
        End With
        MsgBox strFileName, vbInformation, "Invoice Saved as Word.doc"
        
'        Range("G13:I18").ClearContents
'        Range("N14:O18").ClearContents
'        Range("G27:N42").ClearContents
'        Range("G13:I13").ClearContents
'        Range("G49:I49").ClearContents
'        Range("G48:I48").ClearContents
'        Range("G47:I47").ClearContents
'        Range("G46:I46").ClearContents
'        Range("G45:I45").ClearContents
'        Range("N4").Value = Range("N4").Value + 1
'        Worksheets("INV 2").Range("N4").Value = Range("N4").Value
'        Range("G13").Select
'        ActiveWorkbook.Save
    End If
   
End Sub
 
Last edited:
Upvote 0
Hi,
Thanks for that,
I just tried the amended code but keeps saving just like before.
Did you try your code with my supplied worksheet ?

Maybe you could supply your worksheet for me to try this end.

THANKS
 
Upvote 0
You must log in or register to reply here.

Similar threads

G
  • Question Question
Copy Range of Cells based on Criteria, Paste it on rows below it, Do This Until All conditions are met, Then Delete All Copied Rows
Replies
0
Views
542
glaccounting
G
I
  • Question Question
only one code executes after i merged two codes together
Replies
4
Views
740
ipbr21054
I
I
  • Question Question
Run Time Error 13 Type Mismatch
2
Replies
10
Views
1K
DanteAmor
DanteAmor
I
  • Question Question
Existing code needs an edit
Replies
8
Views
749
ipbr21054
I
V
  • Question Question
Invoice Creation
Replies
4
Views
657
Yongle
Yongle

Forum statistics

Threads
1,223,898
Messages
6,175,272
Members
452,628
Latest member
dd2

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top