WORD Macro for Incrementing a Refernce Number and Renaming File

[DanBlooms]

Hello everyone,

this is my first post on here and I'm totally new to Word, Macros, and Visual Basic programming, so apologies if I don't know the lingo, or if you spot me doing anything completely noobish.

I do however have some experience with PHP programming and have spotted a few programming similarities already, so I should be able to muddle through.

I have been attempting to put together a Macro but I am hitting a wall.

I am trying to come up with a better system for creating and logging gift vouchers at work.

I have created a Word Template (.dotm) for the gift voucher. On it, there are some details for staff to fill in when then need to create a gift voucher for a customer.

What I need to do is as follows:

1. Staff create a new Word File based on the Gift Voucher Template.
2. The new Gift Voucher Opens and is given a Gift Voucher Reference Number (this number needs to automatically increment each time a staff member creates a new gift voucher)
3. Staff fill in the fields for the customer's name in a text content control.
4. The rest of the gift voucher details are filled in to complete the form and what I would like ideally is to save the form with a new filename automatically.
5. Ideally, the new filename should be created with this format:

• uniquereferencenumber-giftvoucher-customername-.docextension
• so an example would be 0001 Gift Voucher John Hancock.docx

6. So the system I'm trying to create would end up with a folder full of gift vouchers in a list as follows:

• 0001 Gift Voucher John Hancock.docx
• 0002 Gift Voucher Bill Gates.docx
• 0003 Gift Voucher Frank Black.docx
• 0004 Gift Voucher James May.docx
• and so on and so forth etc, etc.

I've looked around the web and found some snippets that looked useful and hacked together the following code:

Sub AutoNew()

Order = System.PrivateProfileString("C:\Users\info\OneDrive - Blooms Wolverhampton Ltd\Admin\Blooms Templates\GiftvoucherSettings.Txt", _
        "MacroSettings", "Order")


If Order = "" Then
    Order = 1
Else
    Order = Order + 1
End If


System.PrivateProfileString("C:\Users\info\OneDrive - Blooms Wolverhampton Ltd\Admin\Blooms Templates\GiftvoucherSettings.Txt", "MacroSettings", _
        "Order") = Order
        
Dim StrPath As String
StrPath = "C:\Users\info\OneDrive - Blooms Wolverhampton Ltd\Admin\Gift Vouchers\"
        
ActiveDocument.Bookmarks("Order").Range.InsertBefore Format(Order, "000#")
ActiveDocument.SaveAs FileName:=StrPath & Format(Order, "000#") & " " & "Gift Voucher"


End Sub


Private Sub Document_Close()


  Dim strText As String
  Dim sNewFileName As String


strText = ActiveDocument.SelectContentControlsByTitle("CustName")(1).Range.Text


sNewFileName = ActiveDocument.FullName


sNewFileName = Left(sNewFileName, Len(sNewFileName) - 5)
sNewFileName = sNewFileName & " " & strText & ".doc"
ActiveDocument.SaveAs FileName:=sNewFileName, _
  FileFormat:=wdFormatDocument




End Sub

But, this isn't working correctly, and I've become a bit stuck now.

I could get the incrementing reference file working, but then pulling the customer name from the form and amending it to the filename is where things have really started to confuse me.

Notes:

• The unique reference number is stored in a text file in a separate directory.
• The version of Word: Microsoft Office 365 Small Business Premium. Version 1705 (Build 8201.2102)

If anyone could offer any thoughts on the matter it would be very much appreciated.

Best Regards,

Dan

 

[Macropod]

Try something along the lines of:

Option Explicit
Const StrFld As String = "C:\Users\info\OneDrive - Blooms Wolverhampton Ltd\Admin\"
Dim Idx As Long, StrPath As String, strTxt As String: StrPath = StrFld & "Gift Vouchers\"

Sub AutoNew()
Idx = CLng(System.PrivateProfileString(StrFld & "Blooms Templates\GiftvoucherSettings.Txt", "MacroSettings", "Order"))
Idx = Idx + 1
System.PrivateProfileString(StrFld & "Blooms Templates\GiftvoucherSettings.Txt", "MacroSettings", "Order") = Idx
ActiveDocument.Bookmarks("Order").Range.InsertBefore Format(Idx, "0000")
End Sub

Private Sub Document_Close()
With ActiveDocument
  strTxt = " - " & .SelectContentControlsByTitle("CustName")(1).Range.Text & ".doc"
  .SaveAs FileName:=StrPath & Format(Idx, "0000") & " " & "Gift Voucher" & strTxt, FileFormat:=wdFormatDocument
End With
End Sub