Word SaveAs Not Working

[joebrown116]

Hi all,

I keep getting error 5251 on the below code regarding the file name. help!


Sub MailMerge2DOC()
Dim DokName As String
Dim DCM1 As String
DCM1 = Mid(ThisDocument.Name, 1, Len(ActiveDocument.Name) - 4)
'Set to First Record
ThisDocument.MailMerge.DataSource.ActiveRecord = wdFirstRecord
'refresh
DocCheck2 = 0
DokName = 0
'limited
DocNo = 0 'limit start
'Restart Point
Restart:
If ThisDocument.MailMerge.DataSource.DataFields("Employee_Number").Value = DocCheck2 Then
MsgBox "Duplicate Detected! " & ThisDocument.MailMerge.DataSource.DataFields("Employee_Number").Value & " & " & DocCheck2 & ". If this is the last Payroll number in your Mail Merge then your Mail Merge is Complete."
Call MailMerge2PDF
Exit Sub
End If
'limiter
DocNo = DocNo + 1 '+1 to limiter
With ThisDocument.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = ActiveDocument.MailMerge.DataSource.ActiveRecord
.LastRecord = ActiveDocument.MailMerge.DataSource.ActiveRecord
' Remember the wanted documentname
DokName = .DataFields("Nickname").Value & " " & .DataFields("Last_name").Value & " " & .DataFields("Employee_Number").Value ' replace data fields with mail merge fields you want file name to be
End With
Continue:
' Merge the active record
.Execute Pause:=False
End With
' Save then resulting document to DOC 'location to save files
ActiveDocument.SaveAs2 FileName:="C:\Users\UI488820\Desktop\Logo\" & DCM1 & "\" & DokName & ".docx", FileFormat:= _
wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
:=False, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False, CompatibilityMode:=14
' Close the resulting document
If ActiveDocument <> ThisDocument Then
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
Else
End If
'duplicate check
DocCheck2 = vbNullString
DocCheck2 = ThisDocument.MailMerge.DataSource.DataFields("Employee_Number").Value
' Load next record
ThisDocument.MailMerge.DataSource.ActiveRecord = wdNextRecord
'limiter
If DocNo = 500 Then 'default set at 500
MsgBox "500 Limit Reached. Speak to Joe or go into programming and extend limit (replace all 500's with new limit)."
Exit Sub
End If
'Restart
GoTo Restart
End Sub

[gmayor]

Does the path exist?
Does the derived filename contain invalid filename characters?

[joebrown116]

No, the path does not exist.
I don't think there is any invalid characters because if I remove & "\" from FileName:="C:\Users\UI488820\Desktop\Logo\" & DCM1 & "\" & DokName & ".docx" it works.

I'm trying to make a new folder up to in "C:\Users\UI488820\Desktop\Logo\" using the file name.

DCM1 = Mid(ThisDocument.Name, 1, Len(ActiveDocument.Name) - 4) I believe this should get the file name without the extension.

I thought & DCM1 & "\" would make a new folder. If not, how could I make a new folder using vba using the file name?

[gmaxey]

This should illustrate how to see of a folder exists and if not then create it:

Sub Demo()
  If Not fcnFolderExists("C:\Test\Test") Then
    CreateFolder "C:\Test\Test"
  End If
  ActiveDocument.SaveAs2 "C:\Test\Test\Demo.docm"
End Sub
Public Function fcnFolderExists(ByRef strPath As String) As Boolean
Dim lngAttribute As Long
  fcnFolderExists = False
  On Error GoTo err_NoFolder
  'Grab the attributes and test for folder bit.
  lngAttribute = GetAttr(strPath)
  If (lngAttribute And vbDirectory) = vbDirectory Then fcnFolderExists = True
lbl_Exit:
  Exit Function
err_NoFolder:
  Resume lbl_Exit
End Function
Public Function CreateFolder(ByRef strPath As String)
Dim lngIndex As Long
Dim vPath As Variant
  vPath = Split(strPath, "\")
  strPath = vPath(0) & "\"
  For lngIndex = 1 To UBound(vPath)
    strPath = strPath & vPath(lngIndex) & "\"
    If Not fcnFolderExists(strPath) Then MkDir strPath
  Next lngIndex
lbl_Exit:
  Exit Function
End Function