Insufficient memory error when printing to a macro

[Rockystock]

Hi

First ever thread so I hope you can help me.
I was recently using Windows 7 professional and office 2010. I had some macros written for me to aid with my printing. Everything was working fine but I then upgraded to Windows 10, ever since then and at random points when trying to print I receive a 'Run-time error 5322 there is insufficient memory or disk space. Word cannot display the requested font'.

I have tried lots of fixes but none of them worked.
deleted the normal.dotx
repair office
reinstall office
updated printer drivers
Added the macro location as a trusted location

The strange thing is I need to close office but then if I do the same thing to the document it then prints ok.



This has only happened since the upgrade to Win 10 and I have got in touch with the macro writers who have assured me that there is nothing wrong with the macro.

If you have any idea what is causing this error I would be extremely grateful as it causing me no end of frustration and headaches.

Regards

[macropod]

Without seeing the macro in question, it's impossible for anyone here to comment on why it might be causing problems with your documents (notwithstanding what its creators say). That said, it's also possible the problem is caused by congested Temp folder. See: https://support.microsoft.com/en-us/kb/211632. Exiting Office then clearing any orphaned temporary files from the Temp folder may resolve the issue.

[Rockystock]

Thank you Macropod.

Unfortunately I checked the temp folder and their is not anything in there.

Below is the macros I use, sorry for how long it is but I use a few all on one Dotm

'---------------------------------------------------------------------------------------
' Module : modToolbar
' DateTime : 26/03/2015
' Author : Keiron Trott
' Purpose : This modules contains procedures for printing which will be added to the ribbon
' Modified : Keiron Trott
' Purpose : Updates for office 2007-2010. Added printer choosing code from Microsoft
'---------------------------------------------------------------------------------------
 
Option Explicit
Option Compare Text
Private Const csModuleName As String = "modToolbar"
 
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''
'Printer util functions here from microsoft
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''
Const PRINTER_ENUM_CONNECTIONS = &H4
Const PRINTER_ENUM_LOCAL = &H2
Private Declare Function EnumPrinters Lib "winspool.drv" Alias "EnumPrintersA" _
  (ByVal flags As Long, ByVal name As String, ByVal Level As Long, _
  pPrinterEnum As Long, ByVal cdBuf As Long, pcbNeeded As Long, _
  pcReturned As Long) As Long
Private Declare Function PtrToStr Lib "kernel32" Alias "lstrcpyA" _
  (ByVal RetVal As String, ByVal Ptr As Long) As Long
Private Declare Function StrLen Lib "kernel32" Alias "lstrlenA" _
  (ByVal Ptr As Long) As Long
 
Public Function ListPrinters() As Variant
Dim bSuccess As Boolean
Dim iBufferRequired As Long
Dim iBufferSize As Long
Dim iBuffer() As Long
Dim iEntries As Long
Dim iIndex As Long
Dim strPrinterName As String
Dim iDummy As Long
Dim iDriverBuffer() As Long
Dim StrPrinters() As String
iBufferSize = 3072
ReDim iBuffer((iBufferSize \ 4) - 1) As Long
'EnumPrinters will return a value False if the buffer is not big enough
bSuccess = EnumPrinters(PRINTER_ENUM_CONNECTIONS Or _
  PRINTER_ENUM_LOCAL, vbNullString, _
  1, iBuffer(0), iBufferSize, iBufferRequired, iEntries)
If Not bSuccess Then
  If iBufferRequired > iBufferSize Then
    iBufferSize = iBufferRequired
    Debug.Print "iBuffer too small. Trying again with "; _
      iBufferSize & " bytes."
    ReDim iBuffer(iBufferSize \ 4) As Long
  End If
  'Try again with new buffer
  bSuccess = EnumPrinters(PRINTER_ENUM_CONNECTIONS Or _
    PRINTER_ENUM_LOCAL, vbNullString, _
    1, iBuffer(0), iBufferSize, iBufferRequired, iEntries)
End If
If Not bSuccess Then
  'Enumprinters returned False
  MsgBox "Error enumerating printers."
  Exit Function
Else
  'Enumprinters returned True, use found printers to fill the array
  ReDim StrPrinters(iEntries - 1)
  For iIndex = 0 To iEntries - 1
    'Get the printername
    strPrinterName = Space$(StrLen(iBuffer(iIndex * 4 + 2)))
    iDummy = PtrToStr(strPrinterName, iBuffer(iIndex * 4 + 2))
    StrPrinters(iIndex) = strPrinterName
  Next iIndex
End If
ListPrinters = StrPrinters
End Function
 
'You could call the function as follows:
 
' --------------------------------------------------------------------------------
Sub Test()
Dim StrPrinters As Variant, x As Long
StrPrinters = ListPrinters
'Fist check whether the array is filled with anything, by calling another function, IsBounded.
If IsBounded(StrPrinters) Then
  For x = LBound(StrPrinters) To UBound(StrPrinters)
    Debug.Print StrPrinters(x)
  Next x
Else
  Debug.Print "No printers found"
End If
End Sub
 
' --------------------------------------------------------------------------------
Public Function IsBounded(vArray As Variant) As Boolean
'If the variant passed to this function is an array, the function will return True;
'otherwise it will return False
On Error Resume Next
IsBounded = IsNumeric(UBound(vArray))
End Function
 
Function GetFullNetworkPrinterName(strNetworkPrinterName As String) As String
' returns the full network printer name
' returns an empty string if the printer is not found
' e.g. GetFullNetworkPrinterName("HP LaserJet 8100 Series PCL")
' might return "HP LaserJet 8100 Series PCL on Ne04:"
Dim i As Long
 
' if not found let it pass backstring and error
GetFullNetworkPrinterName = strNetworkPrinterName
Dim StrPrinters As Variant
' Dim i As Long
Dim sPrinter As String
Dim sPrinterListed As String
StrPrinters = ListPrinters
sPrinter = ActivePrinter
If IsBounded(StrPrinters) Then
  For i = LBound(StrPrinters) To UBound(StrPrinters)
    sPrinterListed = StrPrinters(i)
    If InStr(UCase(StrPrinters(i)), UCase(strNetworkPrinterName)) Then
      ' ActivePrinter = StrPrinters(i)
      ' Only choose if Network name ends with strNetworkPrinterName
      Dim EndName As String
      EndName = Mid(sPrinterListed, InStrRev(sPrinterListed, "\") + 1)
 
      ' MsgBox EndName
      If UCase(EndName) = UCase(strNetworkPrinterName) Then
        i = UBound(StrPrinters) 'break for loop
        GetFullNetworkPrinterName = sPrinterListed
      End If
    End If
  Next i
  ' MsgBox "Printers available"
End If
End Function
 
Function GetFullNetworkPrinterNameExclude(strNetworkPrinterName As String, strExcludePrinterName As String) As String
' returns the full network printer name
' returns an empty string if the printer is not found
' e.g. GetFullNetworkPrinterName("HP LaserJet 8100 Series PCL")
' might return "HP LaserJet 8100 Series PCL on Ne04:"
Dim i As Long
 
' if not found let it pass backstring and error
GetFullNetworkPrinterNameExclude = strNetworkPrinterName
Dim StrPrinters As Variant
' Dim i As Long
Dim sPrinter As String
Dim sPrinterListed As String
StrPrinters = ListPrinters
sPrinter = ActivePrinter
If IsBounded(StrPrinters) Then
  For i = LBound(StrPrinters) To UBound(StrPrinters)
    sPrinterListed = StrPrinters(i)
    If InStr(UCase(StrPrinters(i)), UCase(strNetworkPrinterName)) And Not (InStr(UCase(StrPrinters(i)), UCase(strExcludePrinterName))) Then
      ' ActivePrinter = StrPrinters(i)
      GetFullNetworkPrinterNameExclude = sPrinterListed
      i = UBound(StrPrinters) 'break for loop
    End If
  Next i
  ' MsgBox "Printers available"
End If
 
End Function
 
'--------------------------------------------------
' Toolbar macros
'--------------------------------------------------
Public Sub PrintOfficeCopy()
' Prints the whole document
If Documents.Count = 0 Then Exit Sub
 
'Get current printer
Dim sCurrentPrinter As String
sCurrentPrinter = ActivePrinter
 
ActivePrinter = GetFullNetworkPrinterName("Mono Duplex")
 
'PDF for testing
''ActivePrinter = "CutePDF Writer"
 
'Set up trays for file copy
'
Dim oSct As Section
Dim iSection As Integer
iSection = 1
'
For Each oSct In ActiveDocument.Sections
  With ActiveDocument.Sections(iSection).PageSetup
    .FirstPageTray = wdPrinterDefaultBin
    .OtherPagesTray = wdPrinterDefaultBin
  End With
  iSection = iSection + 1
  '
Next oSct
 
' print Office copy
Application.PrintOut FileName:="", Range:=wdPrintAllDocument, Item:= _
  wdPrintDocumentContent, Copies:=1, Pages:="", PageType:=wdPrintAllPages, _
  ManualDuplexPrint:=False, Collate:=True
 
'switch printer back
ActivePrinter = sCurrentPrinter
 
End Sub
 
Public Sub PrintClientCopy()
' Prints the page containing the cursor of the current document
If Documents.Count = 0 Then Exit Sub
 
' set to good copy
Dim sDraft As String
sDraft = Options.PrintDraft
Options.PrintDraft = False
 
'----------------
' Select whole document
' Selection.WholeStory
'Get current printer
Dim sCurrentPrinter As String
sCurrentPrinter = ActivePrinter
 
'Set active printer
ActivePrinter = GetFullNetworkPrinterName("Mono Simplex")
 
'For testing
''ActivePrinter = "CutePDF Writer"
 
Dim oSct As Section
Dim iSection As Integer
'
iSection = 1
'
For Each oSct In ActiveDocument.Sections
  If iSection = 1 Then
    With ActiveDocument.Sections(iSection).PageSetup
      .FirstPageTray = wdPrinterUpperBin
      .OtherPagesTray = wdPrinterMiddleBin
    End With
  Else
    With ActiveDocument.Sections(iSection).PageSetup
      .FirstPageTray = wdPrinterMiddleBin
      .OtherPagesTray = wdPrinterMiddleBin
    End With
  End If
 
  iSection = iSection + 1
  '
Next oSct
 
Application.PrintOut FileName:="", Range:=wdPrintAllDocument
'switch printer back
ActivePrinter = sCurrentPrinter
 
Options.PrintDraft = sDraft
 
''Now print office copy
PrintOfficeCopy
 
End Sub
 
Public Sub PrintDocumentCopy()
' Prints the page containing the cursor of the current document
If Documents.Count = 0 Then Exit Sub
 
' set to good copy
Dim sDraft As String
sDraft = Options.PrintDraft
Options.PrintDraft = False
 
'----------------
' Select whole document
' Selection.WholeStory
'Get current printer
Dim sCurrentPrinter As String
sCurrentPrinter = ActivePrinter
 
'Set active printer
ActivePrinter = GetFullNetworkPrinterName("Mono Simplex")
 
'For testing
''ActivePrinter = "CutePDF Writer"
 
Dim oSct As Section
Dim iSection As Integer
'
iSection = 1
'
For Each oSct In ActiveDocument.Sections
  With ActiveDocument.Sections(iSection).PageSetup
    .FirstPageTray = wdPrinterMiddleBin
    .OtherPagesTray = wdPrinterMiddleBin
  End With
  iSection = iSection + 1
'
Next oSct
 
Application.PrintOut FileName:="", Range:=wdPrintAllDocument
'switch printer back
ActivePrinter = sCurrentPrinter
 
Options.PrintDraft = sDraft
 
''Now print office copy
PrintOfficeCopy
 
End Sub
Public Sub PrintDocumentOnly()
' Prints the page containing the cursor of the current document
If Documents.Count = 0 Then Exit Sub
 
' set to good copy
Dim sDraft As String
sDraft = Options.PrintDraft
Options.PrintDraft = False
 
'----------------
' Select whole document
' Selection.WholeStory
'Get current printer
Dim sCurrentPrinter As String
sCurrentPrinter = ActivePrinter
 
'Set active printer
ActivePrinter = GetFullNetworkPrinterName("Mono Simplex")
 
'For testing
''ActivePrinter = "CutePDF Writer"
 
Dim oSct As Section
Dim iSection As Integer
'
iSection = 1
'
For Each oSct In ActiveDocument.Sections
  With ActiveDocument.Sections(iSection).PageSetup
    .FirstPageTray = wdPrinterMiddleBin
    .OtherPagesTray = wdPrinterMiddleBin
  End With
 
  iSection = iSection + 1
'
Next oSct
 
Application.PrintOut FileName:="", Range:=wdPrintAllDocument
'switch printer back
ActivePrinter = sCurrentPrinter
 
Options.PrintDraft = sDraft
 
End Sub
 
Public Sub PrintLetterheadOnly()
' Prints the page containing the cursor of the current document
If Documents.Count = 0 Then Exit Sub
 
' set to good copy
Dim sDraft As String
sDraft = Options.PrintDraft
Options.PrintDraft = False
 
'----------------
' Select whole document
' Selection.WholeStory
'Get current printer
Dim sCurrentPrinter As String
sCurrentPrinter = ActivePrinter
 
'Set active printer
ActivePrinter = GetFullNetworkPrinterName("Mono Simplex")
 
'For testing
''ActivePrinter = "CutePDF Writer"
 
Dim oSct As Section
Dim iSection As Integer
'
iSection = 1
'
For Each oSct In ActiveDocument.Sections
  With ActiveDocument.Sections(iSection).PageSetup
    .FirstPageTray = wdPrinterUpperBin
    .OtherPagesTray = wdPrinterMiddleBin
  End With
 
  iSection = iSection + 1
  '
Next oSct
 
Application.PrintOut FileName:="", Range:=wdPrintAllDocument
'switch printer back
ActivePrinter = sCurrentPrinter
 
Options.PrintDraft = sDraft
 
End Sub

As mentioned previously I have had no issues with this macro when on Win 7 pro and Office 2010, only when I upgraded to Win 10 did the issue start and it seems so random.

Regards

[macropod]

Although the code could be improved, there is nothing obvious about it that would cause the errors you're experiencing. Given that the error message relates to fonts, perhaps you have a corrupt one in use by the document(s) throwing the error. Fixing that would entail identifying the font(s) used in that document that are not used elsewhere and reinstalling them.

As an example of the possible improvements, you could make the code more efficient by replacing:

Dim oSct As Section
Dim iSection As Integer
'
iSection = 1
'
For Each oSct In ActiveDocument.Sections
  With ActiveDocument.Sections(iSection).PageSetup
    .FirstPageTray = wdPrinterUpperBin
    .OtherPagesTray = wdPrinterMiddleBin
  End With
 
  iSection = iSection + 1
  '
Next oSct

with:

Dim oSct As Section
'
For Each oSct In ActiveDocument.Sections
  With oSct.PageSetup
    .FirstPageTray = wdPrinterUpperBin
    .OtherPagesTray = wdPrinterMiddleBin
  End With
Next oSct

If some of the documents have many Sections, you might use something like:

Dim iSection As Long
With ActiveDocument
  For iSection = 1 To .Sections.Count
    With .Sections(iSection).PageSetup
      .FirstPageTray = wdPrinterUpperBin
      .OtherPagesTray = wdPrinterMiddleBin
    End With
    If iSection Mod 20 = 0 Then DoEvents
  Next iSection
End With

Applying DoEvents periodically gives Word scope for its own housekeeping.

PS: When posting code, please use the code tags, indicated by the # button on the posting menu. Without them, your ~400 lines of code lost much of whatever structure it had.

[Rockystock]

Sorry about the code macropod.

Thank you for taking the time to look at it and I will pass that on to the macro writers.

The macro is on a network share and is on many PC's so I don't believe it is a font problem, although it does reference this.
Since my last post I have done another thing, I downgraded a pc from Office 2010 to 2007, this user was getting the issue at least three times a day but since I have downgraded her she has not had it, not for four days now. Another user I have upgraded to Office 2013, this morning and she has not received the error as yet.

I am inclined to think that the error now relates to Office 2010 although I have not given enough time for the upgraded user to make a definite answer.

Are there any issue with office 2010 that you may know that might cause this?

Regards

Mark

[macropod]

Originally Posted by Rockystock

Are there any issue with office 2010 that you may know that might cause this?

It's most unlikely to be anything to do with Office 2010, per se. Neither would the network be likely to make a difference. Fonts on the problem PC running the macro could, though. When you 'downgraded', you probably uninstalled the Office 2010 fonts and replaced them with the Office 2007 equivalent, thereby resolving any problems a corrupt Office 2010 font might have caused.

[Rockystock]

I did consider the problem to be a font problem as it was a fix that I read on a forum, but that would not explain why when I repaired office, it didn't work, nor when I uninstalled and reinstalled office it did not work after a couple of days, could the macro be corrupting the fonts?

[macropod]

Uninstalling Office 2010 doesn't remove its fonts, IIRC, hence reinstalling it won't repair them. Replacing Office 2010 with Office 2007 (or 2013) may replace the Office 2010 fonts with those from Office 2007 (or 2013), thereby 'repairing' them.

Your macro does nothing with fonts, so it can't be corrupting them.

[Rockystock]

Well it does seem that 2013 is working with the macros, as you suggested Macropod.

what I cannot understand is that how the fonts on everyones PC are getting corrupted, however we have had 2013 running for a number of weeks now without any corruptions.

We have decided to upgrade the heavy print users to Office 2013 and the rest of the company stay on office 2010, if they get a corruption on the fonts or should I say an error then they have to come out of the document and go back in, then it usually prints. Not ideal but because we cannot tie it down its all we have got to go with until we upgrade the rest of the staff to office 2013.