If customers file exists then add 2 etc after new file name

[ipbr21054]

Hi,,

I have a userform with TextBox1 & TextBox 2 & CommandButton1
The code in use is shown below.

I open the userform & TextBox 2 is populated from another worksheet.
The value entered is always 6 characters & will never be the same ,example 1A2B3C etc etc

I type the customers name in TextBox1,example JAMES BOND
I then run the CommandButton1 code.

If i go the the folder where the pdf is saved i see the following file for that customer.
JAMES BOND 1A2B3C.pdf

The above is fine & works well.

This is where i need some additional code.
A previous Customer makes another purchase,example JAMES BOND

The value this time is 8A6S22
The saved file this time is as follows.
JAMES BOND 8A6522.pdf

Im thinking that the additional code should look for the customers name only & if present add 2 after his name, if two files for the same customer is present then add 3 etc etc

So example if 1 instance is there.
JAMES BOND 2 "THEN THE CODE"

If 2 files are there then.
JAMES BOND 3 "THEN THE CODE"

If the code to be used struggles to look at customers name only & not the code maybe use something like this JAMES BOND 2 *1A2B3C*
The code then only looks at the characters BEFORE the * "Make Sense"

Many Thanks

Private Sub CommandButton1_Click()
  Dim sPath As String
  Dim strFileName As String
  
  With ThisWorkbook.Worksheets("PRINT LABELS")
    .Range("B3") = Me.TextBox1.Text ' ENTERS CUSTOMERS NAME TO WORKSHEET
    .Range("A3") = Me.TextBox2.Text ' ENTERS PCB NUMBER TO WORKSHEET
  End With
  Unload PrinterForm
                                                                             
  With ActiveSheet
    If .Range("AB1") = "" Then
      MsgBox "NO CODE SHOWN TO GENERATE PDF", vbCritical, "NO CODE ON SHEET TO CREATE PDF"
      Exit Sub
    End If
    strFileName = "C:\Users\Ian\Desktop\REMOTES ETC\DISCO II CODE\DISCO II PDF\" & .Range("B3").Value & " " & .Range("A3").Value & ".pdf"
    .Range("A1:K23").ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFileName, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False
    MsgBox "PDF HAS NOW BEEN GENERATED", vbInformation + vbOKOnly, "GENERATE PDF FILE MESSAGE"
    
  End With
  
  sPath = "C:\Users\Ian\Desktop\REMOTES ETC\DISCO II CODE\DISCO II PDF\"
  strFileName = sPath & Range("B3").Value & " " & Range("A3").Value & ".pdf"
  If Dir(strFileName) <> vbNullString Then
    ActiveWorkbook.FollowHyperlink strFileName
  End If
    
 
End Sub

 

[ipbr21054]

I will be honest with you & say i am unable to look at that & see what i need to do & whether i use my code or only some of it.

 

[Skyybot]

I will be honest with you & say i am unable to look at that & see what i need to do & whether i use my code or only some of it.

Try this.

Private Sub CommandButton1_Click()
  Dim sPath As String
  Dim strFileName As String
Dim customer as String, pcbNbr as String
  
  With ThisWorkbook.Worksheets("PRINT LABELS")
    .Range("B3") = Me.TextBox1.Text ' ENTERS CUSTOMERS NAME TO WORKSHEET
    .Range("A3") = Me.TextBox2.Text ' ENTERS PCB NUMBER TO WORKSHEET
customer = Me.TextBox1.Text
pcbNbr = Me.TextBox2.Text
  End With
  Unload PrinterForm
                                                                             
  With ActiveSheet
    If .Range("AB1") = "" Then
      MsgBox "NO CODE SHOWN TO GENERATE PDF", vbCritical, "NO CODE ON SHEET TO CREATE PDF"
      Exit Sub
    End If

    strFileName = savePath(customer) & "\" & pcbNbr & ".pdf"
    .Range("A1:K23").ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFileName, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False
    MsgBox "PDF HAS NOW BEEN GENERATED", vbInformation + vbOKOnly, "GENERATE PDF FILE MESSAGE"
    
  End With
  
 
  If Dir(strFileName) <> vbNullString Then
    ActiveWorkbook.FollowHyperlink strFileName
  End If
    
 
End Sub
Function savePath(custName As String)

Dim fs, f, s

Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder("C:\Users\Ian\Desktop\REMOTES ETC\DISCO II CODE\DISCO II PDF")
Set s = f.SubFolders

For Each folder In s
    If folder.Name = custName Then
        sPath = "C:\Users\Ian\Desktop\REMOTES ETC\DISCO II CODE\DISCO II PDF\" & custName
        savePath = sPath
        Exit Function
    End If
Next folder

s.Add custName
sPath = "C:\Users\Ian\Desktop\REMOTES ETC\DISCO II CODE\DISCO II PDF\" & custName
savePath = sPath

End Function

 

[ipbr21054]

I have applied the code above but see screen shot .
Look at the Function code part does it look correct ?

I ask because there are no saved files in the folder DISCO II PDF

So as a test i did the same thing & for the name i entered Z999
The code runs fine with no issue or run time errors.
I see the messagebox about pdf has ben generated.

I do a search on the pc for Z 999 but told no files found.

 

[Skyybot]

I have applied the code above but see screen shot .
Look at the Function code part does it look correct ?

I ask because there are no saved files in the folder DISCO II PDF

So as a test i did the same thing & for the name i entered Z999
The code runs fine with no issue or run time errors.
I see the messagebox about pdf has ben generated.

I do a search on the pc for Z 999 but told no files found.

Do you see any new Folders in DISCO II PDF?

 

[ipbr21054]

No

That’s why I did a search for what should have been saved but was told unable to find such file.

 

[Skyybot]

No

That’s why I did a search for what should have been saved but was told unable to find such file.

I don't know what to tell you. It's working on my machine.

 

[Skyybot]

You know what? I just noticed that you're using an older version of Office than I am. I think that my be the problem. Sorry.