#1
|
|||
|
|||
Error 4605 on Word Section Save VBA procedures all the time
Hello there,
I have spent the last 2-3 hours going through back-and-forth's on various forums/threads on error code 4605 and none of them seemed to do the trick. An advice here, an instruction or code clean up there, with some of the helpees not even taking the time to respond or say thanks. As I read through stuff elsewhere, it is about not working for the second time. Yesterday I was able to run macros and get some of my work done (applying Headings then changed them to Section breaks, finally doing it batch style on some 100 docs) and spent the day cleaning up the files before I wanted to run one of the Document Split by Sections macros available on the internet. I would not go into copying code here, because the code was taken from experts and must run perfectly. I just cannot seem to be able to run them anymore. The least 3-4 times it was the Paste argument/line that caused the problem (copying to clipboard and pasting again). I have something like 6000 sections in the 100 docs I need to save individually. I cannot do it one by one. It would be madness. I am on Office 16, Win 10. Could it be done with some RegEdit fix? It seems like something is stuck here with Word. I tried everything, different folders (going to the trusted OneDrive folder even), removed accents from file names, changed docx to dotx to run macros locally, unchecked mail attachment bit, gave access to everything in Trust Center, everything to hell and back. It always comes back with the same annoying result. I was going to write up a question needing help with specifics (with regard to saving the files to names I wanted), but I couldn't even get there, alas. Thanks in advance, Z. Last edited by zanodor; 06-30-2022 at 07:33 PM. |
#2
|
||||
|
||||
Are you expecting us to also spend 2-3 hours looking for what 4605 means and what vba code might cause it to occur?
If you have a problem with code you need to post that code. If your otherwise functional code has a problem with your documents, you need to post both the code and a representative document that allows us to recreate the error.
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#3
|
|||
|
|||
Quote:
This did not run: Code:
Sub SaveEachSectionAsADoc() Dim objDocAdded As Document Dim objDoc As Document Dim nSectionNum As Integer Dim strFolder As String Dim dlgFile As FileDialog ' Initialization Set objDoc = ActiveDocument Set dlgFile = Application.FileDialog(msoFileDialogFolderPicker) ' Pick a location to keep new files. With dlgFile If .Show = -1 Then strFolder = .SelectedItems(1) & "\" Else MsgBox "Select a folder first!" Exit Sub End If End With ' Step through each section in current document, copy and paste each to a new one. For nSectionNum = 1 To ActiveDocument.Sections.Count Selection.GoTo What:=wdGoToSection, Which:=wdGoToNext, Name:=nSectionNum ActiveDocument.Sections(nSectionNum).Range.Copy Set objDocAdded = Documents.Add Selection.Paste ' Save and close new documents. objDocAdded.SaveAs FileName:=strFolder & "Section " & nSectionNum & ".docx" objDocAdded.Close Next nSectionNum End Sub Code:
Sub BreakOnSection() Dim i As Long Dim DocNum As Long Dim docOld As Document Dim docNew As Document Set docOld = ActiveDocument 'A mail merge document ends with a section break next page. 'Subtracting one from the section count stop error message. For i = 1 To docOld.Sections.Count 'Select and copy the section text to the clipboard. docOld.Sections(i).Range.Copy 'Create a new document to paste text from clipboard. Set docNew = Documents.Add Selection.Paste ' Removes the break that is copied at the end of the section, if any. Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend Selection.Delete Unit:=wdCharacter, Count:=1 DocNum = DocNum + 1 docNew.SaveAs FileName:="Section_" & DocNum & ".docx", _ FileFormat:=wdFormatXMLDocument docNew.Close 'Move the selection to the next section in the document. Application.Browser.Next Next i docOld.Close SaveChanges:=wdDoNotSaveChanges End Sub Code:
Option Explicit 'Add Microsoft Scripting Runtime to Resourses before using this procedure Public pPath As String Public pFileName As String Public pSrcFileName As String Sub CallUF() Dim myFrm As UserForm1 If Not ActiveDocument.Saved Then If MsgBox("You must save this document before running this procedure." _ & " Do you want to save it now?", vbQuestion + vbYesNo, _ "File Not Saved") = vbYes Then ActiveDocument.Save Else Exit Sub End If End If pSrcFileName = ActiveDocument.FullName Set myFrm = New UserForm1 myFrm.Show Unload myFrm Set myFrm = Nothing End Sub Function DirPath(ByRef strVer As String) As String 'Add Microsoft Scripting Runtime to Resourses before running this code On Error GoTo Err_Handler Select Case strVer Case "11.0", "12.0", "14.0" Dim fso As New FileSystemObject Dim fd As FileDialog Dim AbsolutePath As String Set fd = Application.FileDialog(msoFileDialogFolderPicker) With fd .Title = "Pick the destination directory for the new files." .AllowMultiSelect = False .InitialView = msoFileDialogViewList If .Show = -1 Then AbsolutePath = fso.GetAbsolutePathName(.SelectedItems.Item(1)) If Right(AbsolutePath, 1) <> "\" Then AbsolutePath = AbsolutePath + "\" DirPath = AbsolutePath Else DirPath = "****CANCELED BY USER****" End If End With Case Else Err_ReEntry: AbsolutePath = InputBox("Enter the directory path where you want to " _ & "save the individual files.", "File Path", "C:\") If Right(AbsolutePath, 1) <> "\" Then AbsolutePath = AbsolutePath + "\" DirPath = AbsolutePath End Select On Error GoTo 0 Exit Function Err_Handler: Resume Err_ReEntry End Function Function SaveAsType(ByRef oDoc_Passed) As Long SaveAsType = oDoc_Passed.SaveFormat End Function Function GetExtension(ByRef strFileName As String) As String Dim arrStrings() As String arrStrings() = Split(strFileName, ".") If UBound(arrStrings) > 0 Then GetExtension = arrStrings(UBound(arrStrings)) End If End Function Other times (when not a copy/paste clipboard routine was implemented) it simply came up with error code 4605: "Run-time error '4605': This command is not available." (Yet my document is always active. Again, when I hopped into Visual Basic, Selection.Paste was highlighted yellow.) On other occasions, nothing was running, not even an error came back (when I tried no active document, if I remember correctly). |
#4
|
||||
|
||||
Using the Selection object is not recommended, especially when your code is opening/closing new documents. If your code does the right thing and defines objDoc then it should also start making use of that to ensure the code (and observers) doesn't confuse the new docs with the original doc. Also, you can get big changes in formatting if you are inserting content into a new document with different style definitions. The following changes to the code should deal with each of those problems.
Code:
Sub SaveEachSectionAsADoc() Dim objDocAdded As Document, objDoc As Document Dim nSectionNum As Integer, strFolder As String Dim dlgFile As FileDialog ' Initialization Set objDoc = ActiveDocument Set dlgFile = Application.FileDialog(msoFileDialogFolderPicker) ' Pick a location to keep new files. With dlgFile If .Show = -1 Then strFolder = .SelectedItems(1) & "\" Else MsgBox "Select a folder first!" Exit Sub End If End With ' Step through each section in current document, copy and paste each to a new one. For nSectionNum = 1 To objDoc.Sections.Count Set objDocAdded = Documents.Add(Template:=objDoc.FullName) objDocAdded.Range.FormattedText = objDoc.Sections(nSectionNum).Range.FormattedText ' Save and close new documents. objDocAdded.SaveAs FileName:=strFolder & "Section " & nSectionNum & ".docx" objDocAdded.Close Next nSectionNum End Sub
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#5
|
|||
|
|||
Fixed!
Quote:
https://www.msofficeforums.com/137818-post4.html and carrying out a Quick Repair, MS Word 16 and macros are running as expected. Unfortunately, I had to do it again a third time now... Thank you Last edited by zanodor; 07-01-2022 at 01:40 PM. |
#6
|
|||
|
|||
Thanks
Quote:
EDIT. I tried your code with a slight update and the error for Paste was gone. Imagine I ran Repair on Office 3 times already! Super, many thanks. Cheers, Z. |
Tags |
macro, vba |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Error 4605 while trying to copy and paste with same document | Ilmari | Word VBA | 2 | 05-05-2020 12:08 AM |
run-time error 4605 command not available with Selection.paste | Marzio | Word VBA | 14 | 01-30-2019 04:46 AM |
Word Error Message Run time Error 4605 | baes10 | Word VBA | 1 | 08-30-2018 02:37 PM |
Error 4605 when looping through files in folder and deleting comments | Peterson | Word VBA | 2 | 04-19-2018 08:45 AM |
PasteAppendTable not available (Run-Time Error 4605) | q_scribe | Word VBA | 1 | 08-12-2013 09:56 AM |