Hi,
I’ve a problem with a macro in Word. After running the macro several times I receive “the Run-time error 5112, there is not enough memory or disk space to complete the operation”. Restarting Outlook (using Word as editor) and Word solve this problem until the next error. First I use a script in Outlook and then the one in Word witch is giving the problem (I believe).
OUTLOOK:
Private Sub GetContact()
Dim objApp As Application
Dim objNS As NameSpace
Dim objSelection As Selection
Set objApp = CreateObject("outlook.application")
Set objNS = objApp.GetNamespace("MAPI")
Set objSelection = objApp.ActiveExplorer.Selection
If objSelection.Count <> 1 Then
MsgBox "Niet meer dan één item selecteren a.u.b."
GoTo Exit_GetContact
Else
Set m_objitem = objSelection.Item(1)
If m_objitem.Class <> olContact Then
MsgBox "Selecteer een contactpersoon."
GoTo Exit_GetContact
End If
End If
Exit_GetContact:
Set objSelection = Nothing
Set objNS = Nothing
Set objApp = Nothing
End Sub
Private Sub Opendoc(strtemplate As String)
Dim objword As Word.Application
On Error Resume Next
Set objword = GetObject(, "Word.application")
If objword Is Nothing Then
Set objword = CreateObject("word.application")
End If
On Error GoTo 0
objword.Visible = True
Set m_objDoc = objword.Documents.Add(strtemplate)
Set objword = Nothing
Set m_objDoc = Nothing
End Sub
Private Sub FillFormFields()
On Error Resume Next
m_objDoc.Bookmarks("CompanyName").Range.InsertBefore m_objitem.CompanyName
m_objDoc.Bookmarks("FullName").Range.InsertBefore m_objitem.FullName
m_objDoc.Bookmarks("BusinessFaxNumber").Range.InsertBefore m_objitem.BusinessFaxNumber
On Error GoTo 0
End Sub
Private Sub FillFormFieldsBrief()
On Error Resume Next
m_objDoc.Bookmarks("CompanyName").Range.InsertBefore m_objitem.CompanyName
m_objDoc.Bookmarks("FullName").Range.InsertBefore m_objitem.FullName
m_objDoc.Bookmarks("BusinessAddressStreet").Range.InsertBefore m_objitem.BusinessAddressStreet
m_objDoc.Bookmarks("BusinessAddressPostalCode").Range.InsertBefore m_objitem.BusinessAddressPostalCode
m_objDoc.Bookmarks("BusinessAddressCity").Range.InsertBefore m_objitem.BusinessAddressCity
On Error GoTo 0
End Sub
Private Sub GaNaar()
ActiveDocument.Bookmarks("GaNaar").Range.Select
End Sub
Private Sub UpdateField()
ActiveDocument.Fields.Update
End Sub
Sub TechnicalFaxOrderNL()
Call GetContact
Call Opendoc("\\Jaczon_srv3\templates\Technical_Department\FaxorderNL.doc")
Call FillFormFields
Call UpdateField
Call GaNaar
Set m_objDoc = Nothing
Set m_objitem = Nothing
End Sub
WORD:
Sub SaveOrder()
Dim dlgSaveAs As FileDialog
Set dlgSaveAs = Application.FileDialog( _
FileDialogType:=msoFileDialogSaveAs)
dlgSaveAs.InitialFileName = ActiveDocument.Bookmarks("PoNumber").Range.Text & "-" & ActiveDocument.Bookmarks("CompanyName").Range.Text
dlgSaveAs.Show
If dlgSaveAs.InitialFileName <> "" Then dlgSaveAs.Execute
Set dlgSaveAs = Nothing
ActiveDocument.Close
End Sub
I’ve a problem with a macro in Word. After running the macro several times I receive “the Run-time error 5112, there is not enough memory or disk space to complete the operation”. Restarting Outlook (using Word as editor) and Word solve this problem until the next error. First I use a script in Outlook and then the one in Word witch is giving the problem (I believe).
OUTLOOK:
Private Sub GetContact()
Dim objApp As Application
Dim objNS As NameSpace
Dim objSelection As Selection
Set objApp = CreateObject("outlook.application")
Set objNS = objApp.GetNamespace("MAPI")
Set objSelection = objApp.ActiveExplorer.Selection
If objSelection.Count <> 1 Then
MsgBox "Niet meer dan één item selecteren a.u.b."
GoTo Exit_GetContact
Else
Set m_objitem = objSelection.Item(1)
If m_objitem.Class <> olContact Then
MsgBox "Selecteer een contactpersoon."
GoTo Exit_GetContact
End If
End If
Exit_GetContact:
Set objSelection = Nothing
Set objNS = Nothing
Set objApp = Nothing
End Sub
Private Sub Opendoc(strtemplate As String)
Dim objword As Word.Application
On Error Resume Next
Set objword = GetObject(, "Word.application")
If objword Is Nothing Then
Set objword = CreateObject("word.application")
End If
On Error GoTo 0
objword.Visible = True
Set m_objDoc = objword.Documents.Add(strtemplate)
Set objword = Nothing
Set m_objDoc = Nothing
End Sub
Private Sub FillFormFields()
On Error Resume Next
m_objDoc.Bookmarks("CompanyName").Range.InsertBefore m_objitem.CompanyName
m_objDoc.Bookmarks("FullName").Range.InsertBefore m_objitem.FullName
m_objDoc.Bookmarks("BusinessFaxNumber").Range.InsertBefore m_objitem.BusinessFaxNumber
On Error GoTo 0
End Sub
Private Sub FillFormFieldsBrief()
On Error Resume Next
m_objDoc.Bookmarks("CompanyName").Range.InsertBefore m_objitem.CompanyName
m_objDoc.Bookmarks("FullName").Range.InsertBefore m_objitem.FullName
m_objDoc.Bookmarks("BusinessAddressStreet").Range.InsertBefore m_objitem.BusinessAddressStreet
m_objDoc.Bookmarks("BusinessAddressPostalCode").Range.InsertBefore m_objitem.BusinessAddressPostalCode
m_objDoc.Bookmarks("BusinessAddressCity").Range.InsertBefore m_objitem.BusinessAddressCity
On Error GoTo 0
End Sub
Private Sub GaNaar()
ActiveDocument.Bookmarks("GaNaar").Range.Select
End Sub
Private Sub UpdateField()
ActiveDocument.Fields.Update
End Sub
Sub TechnicalFaxOrderNL()
Call GetContact
Call Opendoc("\\Jaczon_srv3\templates\Technical_Department\FaxorderNL.doc")
Call FillFormFields
Call UpdateField
Call GaNaar
Set m_objDoc = Nothing
Set m_objitem = Nothing
End Sub
WORD:
Sub SaveOrder()
Dim dlgSaveAs As FileDialog
Set dlgSaveAs = Application.FileDialog( _
FileDialogType:=msoFileDialogSaveAs)
dlgSaveAs.InitialFileName = ActiveDocument.Bookmarks("PoNumber").Range.Text & "-" & ActiveDocument.Bookmarks("CompanyName").Range.Text
dlgSaveAs.Show
If dlgSaveAs.InitialFileName <> "" Then dlgSaveAs.Execute
Set dlgSaveAs = Nothing
ActiveDocument.Close
End Sub