Ошибка vbscript outlook

Our computers were upgraded to Office 2007.  The following script fails to work on 2007, but works in 2003.

Look for the comment FAILS HERE

CreateObject(«Outlook.Application») returns an error that the ActiveX object cannot be created:

' ------------------------------------------- LOADMAILBOX ---------------------------------------------
	public SevereError
	Dim NS					  ' As NameSpace
	Dim objOutlook				' As Application
								' Dim objInbox As Outlook.MAPIFolder
	Dim objFolder				' As Outlook.MAPIFolder
	Dim Item          ' As Object
	Dim objItems				' As Object, MailItem but could be something else
	'Dim ItemCount				' Number of mailbox items from objFolder.Items.Count, from LoadMailBox
	Dim Icount				  ' Folder loop counter
	Dim strFolderName

	Set NS = Nothing
	set objOutlook = Nothing
	'Set objInbox = Nothing
	'Set objFolder = Nothing
	'Set objItems = Nothing
	dim env
	env=1
	
	strFolderName = "Public Folders/All Public Folders/USN/NAVAIR/ORLO/Functional Mailboxes/ORLO_498 MUSTER"
	
	set objOutlook = Nothing
	On Error GoTo 0
	Set objOutlook = CreateObject("Outlook.Application")
	

	'Try starting outlook again if it wasn't running SCRIPT FAILS HERE!!!!!
	If objOutlook Is Nothing Then 
		Set objOutlook = CreateObject("Outlook.Application")
	End If

'THIS SECOND TRY IS SIMPLE DESPERATION.....
	Set NS = objOutlook.GetNamespace("MAPI")
	Set objFolder = GetFolder(strFolderName)
	AddInfo "Using Mailbox: " & strFolderName ,1
	On Error Resume Next

	MessageCount = CInt(objFolder.Items.Count)
	AddInfo ("LoadMailBox Messagecount=" & MessageCount), 1

	AddInfo "Loading Muster Mailbox content",1
	Set Item = objFolder.Items
	On Error Goto 0

	For Icount = 1 To MessageCount
		' MessageCount comes from the count property of the folder in Outlook
		addinfo "LoadMailBox, Icount = " & Icount & " MessageCount=" & MessageCount, 1
		addinfo "SentOn =   " & Item(Icount).SentOn, 1
		addinfo "SenderName = " & Item(Icount).SenderName, 1
		addinfo "Subject =  " & Item(Icount).Subject, 1
		addinfo "Body =    " & Item(Icount).Body, 1
	Next 'Icount

	' **************************** END READ MAILBOX LOOP *********************************
	' ******************* LOADING OF MESSAGES INTO MEMORY IS COMPLETE *****************
	'          This means all the messages, regardless of date




	AddInfo MessageCount & " Muster Messages found in LoadMailBox, Reading Inbox complete.", 1


'-------------------------------  GETFOLDER ---------------------------------------------
Public Function GetFolder(strFolderPath)

	' folder path needs to be something like:
	' "Public FoldersAll Public FoldersCompanySales"

	Dim objApp			' As Outlook.Application
	Dim objNS      ' As Outlook.NameSpace
	Dim colFolders			' As Outlook.Folders
	Dim objFolder			' As Outlook.MAPIFolder
	Dim arrFolders			' As String array
	Dim I				' As Long

	On Error Goto 0
	'On Error Resume Next

	if dbg then AddInfo "GetFolder path = " & strFolderPath, 1

	strFolderPath = Replace(strFolderPath, "/", "")
	if dbg then AddInfo "Adjusted folder path = " & strFolderPath,1
	arrFolders = Split(strFolderPath, "")
	Set objApp = CreateObject("Outlook.Application")

	' If Outlook is not installed, the folder will be nothing
 	If Err.number <> 0 Then
		AddInfo "Function GetFolder, CreateObject Outlook.Application",1
		ShowError
		Err.Clear
		On Error Goto 0
		Severe_Error = True
		'GetFolder = Nothing
		'objApp = Nothing
		Exit Function
 	End If

	Set objNS = objApp.GetNamespace("MAPI")
	Set objFolder = objNS.Folders.Item(arrFolders(0))

	On Error Resume Next

	If Not objFolder Is Nothing Then
		For I = 1 To UBound(arrFolders)
			Set colFolders = objFolder.Folders
			Set objFolder = Nothing
			Set objFolder = colFolders.Item(arrFolders(I))

			If Err.Number <> 0 then
				Msgbox "It appears that you do not have access permissions to the Muster Mailbox, call the Mailbox Owner"
				Err.Clear
				Severe_Error = True
				Exit Function
			End If

			if dbg then AddInfo "Folder = " &objFolder, 1

			If objFolder Is Nothing Then
				Exit For
			End If
		Next 'I

	Else

		GetFolder = Nothing
	End If


	Set GetFolder = objFolder
	'If Dbg Then  MsgBox("Getfolder is returning " & GetFolder)

	On Error Resume Next
	Set colFolders = Nothing
	Set objNS = Nothing
	Set objApp = Nothing
	On Error Goto 0
End Function



' ------------------------------------- ADDINFO ---------------------------------------
Sub AddInfo(Text, NewLine)
	Dim L 

	If Env=1 Then
		If NewLine then
			Wscript.StdOut.WriteLine Text
		Else
			Wscript.StdOut.Write Text
		End If

		'WScript.Echo Text
	Else
		L = Len(Text2) + Len(Text)
		if L >32767 then Text2 = Right(Text2, 32760 - Len(Text))

		if newline then 
			Text2 = Text2 & vbcrlf & text 
			TextArea2.value = Text2
		else
			TextArea2.value = Text2 & Text
		end if
	End If

	End Sub

 Thanks for your help!!

Mark

Navy Firefighting Engineer

I’m designing a Outlook Contact form. None of the sample code I’ve tried to put in the View Code button’s Script Editor does anything. The most basic example is:

Sub Item_Open()
 msgbox "Hello World"
End Sub

When I click the Run This Form button, no message box or error message appears. It seems to totally ignore the VBScript. The same thing happens with every bit of sample code I’ve tried.

This is my first time doing any development for Office or in VBA or VBScript, so I assume I’m missing something basic, but I’ve watched and read a few tutorials, doing exactly what was shown and nothing works. I can design and publish a Contact form with custom fields and and basic combo boxes.

In the Trust Center I have Macro Settings set to «Notifications for all macros» and the Email Security options «Allow script in shared folders» and «Allow script in Public Folders» are both checked.

I’m designing a Contact form using Office 365 32-bit Version 1708 (Build 8431.2079 Click-to-Run) Monthly Channel on Windows 10 x64 Version 1703 Build 15063.608.

Any help would be greatly appreciated!!

Thank you!