Need Help | VBA | Doc.Name Via .TXT File

Okay - Hang in there with me while I try to explain...

What I have so far:

CommandButton1 - Creates a new Document
CommandButton2 - Saves Document
A .txt file with a string number value. I started mine at 1000. (I am calling this my "Design Number").

When I Create a New Document via Commandbutton1 the ActiveDocument.Name is the string value on the .txt file + 1. (I'm generating design numbers that count up). Basically for every new document via the macro is a new design number naming that document.

When I Save Document (commandbutton2) - The New Document.Name should replace the string in the txt file with 1001. But this part isnt working.

And it should keep going up from there every time i create a new document and save it.

Private Sub commandButton1_Click()

Dim TextFile As Integer
Dim FilePath As String
Dim FileContent As String

On Error Resume Next
FilePath = "C:\Users\chier\Desktop\Design Number" & ".txt"

TextFile = FreeFile

Open FilePath For Input As TextFile

FileContent = Input(LOF(TextFile), TextFile)

ActiveDocument.Name = FileContent

Close TextFile

Dim doc1 As Document
Set doc1 = CreateDocument()
doc1.Name = FileContent + 1

End Sub

Private Sub commandButton2_Click()

'(This is where stuff starts action crazy i think). IT doesnt save properly i think.

Dim TextFile As Integer
Dim FilePath As String

FilePath = "C:\Users\chier\Desktop\New Text Document" & ".txt"

TextFile = FreeFile

Open FilePath For Output As TextFile ' Replaces Each Line in File
'Open FilePath For Append As TextFile ' Adds additional Lines

On Error Resume Next
Print #TextFile, ActiveDocument.Name

Close TextFile

ActiveDocument.SaveAs "C:\Users\chier\Desktop\" & ActiveDocument.Name & ".cdr"
End Sub

Any adjustments will be helpful :)

Top Replies

NudeFan over 5 years ago in reply to CDT +1

Oki, hopefully now I understood what you need. You ever spend an idea to split the information and saving only a number in the file and generate out of it a file name? With the way you do it with the...

Parents

No Data

Reply

NudeFan over 5 years ago

The problem you describe in your script is, that you want to save a document name (including extension!!!) into a text file. Then you try to convert this filename into a number which will fail and result as 0.
To avoid this, you could to the following:
Store the ActiveDocument.Name in a string variable, search for the first dot and cut off the part starting at that position. Then you have again only your number and it will work.

Since I'm very familiar with this kind of problem, I would suggest an absolutely different solution. This way even allows you to give your document a name in addition to the version number.
In my example you even can start with a version 0 with 3 or more leading zeros:

Option Explicit

Sub aaTestMe()

SaveAsNext ActiveDocument, "C:\Temp\2018\Test\ForCDT_01_1000.Cdr"

End Sub

Sub SaveAsNext(ByRef iDoc As Document, ByVal pDefault As String)

Dim CurPath As String, CurBody As String, CurNum As String, CurExt As String, CurName As String
Dim CurFile As String, MaxFile As String
Dim n1 As Integer, n2 As Integer, Ch1 As String, Ch2 As String

CurName = pDefault
n1 = InStrRev(CurName, ".")
CurExt = Mid(CurName, n1)
CurName = Left(CurName, n1 - 1)
n1 = InStrRev(CurName, "\")
CurPath = Left(CurName, n1)
CurBody = Mid(CurName, n1 + 1)

n1 = InStrRev(CurBody, "_")
CurNum = Mid(CurBody, n1 + 1)
CurBody = Left(CurBody, n1)

'After splitting the default name into different needed parts we explore, what is already existent

MaxFile = ""
CurFile = Dir(CurPath + CurBody + "*" + CurExt)
While CurFile <> ""
   If MaxFile = "" Then
      MaxFile = UCase(CurFile)
   Else
      If UCase(CurFile) > MaxFile Then MaxFile = UCase(CurFile)
   End If
   CurFile = Dir
Wend

If MaxFile <> "" Then 'at least one file of that default name exists
   n1 = InStrRev(MaxFile, ".")
   MaxFile = Left(MaxFile, n1 - 1) ' cuts off the extention
   Ch1 = Mid(MaxFile, Len(CurBody) + 1) 'Cuts out the highest numeric part of the series
   n1 = Val(Ch1) + 1 'convert this to the next number
   Ch1 = Trim(Str(n1)) 'makes a string
   While Len(Ch1) < Len(CurNum)
      Ch1 = "0" + Ch1
   Wend 'fills the leading zeros, so that you can start also with 0
   CurNum = Ch1
End If

CurName = CurPath + CurBody + CurNum + CurExt
iDoc.SaveAs CurName

End Sub
Cancel
Up 0 Down

Reply

Cancel

Children

CDT over 5 years ago in reply to NudeFan

NudeFan! You went way deep into this! This is helpful, though and Im starting to parse it. Thank you for taking the time to help me. Also, I got my code to work. I'm currently utilizing yours for other routes.

If you wanted test the code out! It's below.

1. Create a text file called Design Number. Type 1000 inside and save it.

2. Change the path on the code below to your new path.

3. Then run Sub newDesignNumber() // Make sure corel is open - obviously.

Option Explicit

Sub newDesignNumber()

Dim TextFile As Integer
Dim FilePath As String
Dim FileContent As String

On Error Resume Next
FilePath = "C:\Users\chier\Desktop\" & "Design Number" & ".txt"

TextFile = FreeFile

Open FilePath For Input As TextFile

FileContent = Input(LOF(TextFile), TextFile)

ActiveDocument.Name = FileContent

Close TextFile

Dim doc1 As Document
Set doc1 = CreateDocument()
doc1.Name = FileContent + 1

Call nextDesignNumber
End Sub

Private Sub nextDesignNumber()

Dim TextFile As Integer
Dim FilePath As String

FilePath = "C:\Users\chier\Desktop\" & "Design Number" & ".txt"
TextFile = FreeFile

Open FilePath For Output As TextFile ' Replaces Each Line in File

On Error Resume Next
Print #TextFile, ActiveDocument.Name

Close TextFile

End Sub

It's simple and not perfect ... I know it. But it's easy to manage and does what I need it to. Hopefully this helps others who need something similar!
Cancel
Up 0 Down

Reply

Cancel