Run-time error '429': ActiveX component can't create object

Question

Dear All

I have the following environment Windows server 2003 server ,office 2007 ,Moss 20007

I have a application hosted on Moss ,where when user clicks on the download button on a page where  few files get downloaded in the Users system.The files are downloaded using  VB script.

since couple of days i am getting a error

"Run-time error '429': ActiveX component can't create object" when i click download button .

I am pasting the VB Script .

<

<script  language="VBScript">

<!--

Option Explicit

Err.number = 0

Const adTypeBinary = 1

Const adSaveCreateOverWrite = 2

Const INFO_OK = 1

Const INFO_OKCANCEL = 2

Const SEND_ERR = 3

Const PGM_ERR = 4

Const WAITTIME = 500

Const MAX_COUNT = $Cnt$

Const FOLDER_PATH = "*Folder*"

Const IMAGE_PATH = "*Image*"

 

Dim msg1

Dim msg2

Dim msg3

Dim FinalCount

msg1 = "Click " & Chr(34) & "OK" & Chr(34) & " to start downloading files." & Chr(13) & "(Notice) Do not close this program until all files are downloaded.."

msg2 = "Downloaded successfully."

msg3 = "The file may have been deleted or renamed, please reload this browser and try again."

 

 

getFirstFreeDriveLetter()

 

Dim i

Dim cnt

Dim File_Count

 

*SounceTargetFilePaths*

*SounceTargetFilePaths1*

 

Dim Xfer

Dim File

 

Function SendPlm()       

                document.getElementById("FileCount").innerHTML = ""

                Dim flg

                flg = Message (INFO_OKCANCEL, msg1, "" )       

                if flg = vbCancel then

                                exit Function

                end if

                Initialize "1"

                if Err.number <> 0 then

                                                Message PGM_ERR , "", ""

                                                Exit Function

                End if

                CreateFolder(GetFirstFreeDriveLetter&IMAGE_PATH)

                               

        CreateFolder(GetFirstFreeDriveLetter&FOLDER_PATH)

                                setTimeout "OneDownload()", WAITTIME

                               

End Function

 

Function OneDownload()

 

 

 

if MAX_COUNT > 0 then

 

File_Count = MAX_COUNT - 2

 

 

 

if i <= MAX_COUNT then

               

                   

                Download FileName(i), FileUrl(i)

                if Err.number <> 0 then

         Initialize""

                Exit Function

                end if

 

 

                                if i <= File_Count then

                                document.getElementById("FileCount").innerHTML = i + 1 &  " of " & File_Count + 1

                                end if

                i = i + 1

                setTimeout "OneDownload()", WAITTIME

else

                CreateIndex()

                document.getElementById("FileCount").innerHTML = File_Count + 1 & " of " & File_Count + 1  & " Completed."

 

 

                Dim msgDown

                msgDown = "All documents downloaded successfully."

                Dim flg

                flg = Message (INFO_OK, msgDown, "" )              

                Initialize""

end if

end if

end Function

 

Function Download(name,url)  

 

                On Error Resume Next

                Xfer.Open "GET", url, False        

                                

                if Err.number <> 0 then

                                Message PGM_ERR, "", ""

 

                                Exit Function

                End if

 

                Xfer.Send

                if Xfer.Status <> 200 then

                                Message SEND_ERR , msg3 , url

                                Err.number = Xfer.Status

                               

                                Exit Function

                end if

                File.Type = adTypeBinary

                File.Open

                if Err.number <> 0 then

                                Message PGM_ERR, "", ""

                                

                                File.Close

                                Exit Function

                End if

               

                File.Write Xfer.responseBody

                

                File.SaveToFile GetFirstFreeDriveLetter&name, adSaveCreateOverWrite

                if Err.number <> 0 then

                                Message PGM_ERR, "", ""

                                

                                File.Close

                                Exit Function

                End if

                

                File.Close

               

end Function

 

Function getFirstFreeDriveLetter()

Dim objFSO, strLetters, i,  blnError

Set objFSO = CreateObject("Scripting.FileSystemObject")

   

    strLetters = "CDEFGHIJKLMNOPQRSTUVWXYZ"

    GetFirstFreeDriveLetter = ""

    blnError = True

   

 

    For i=1 to len(strLetters)

 

        If objFSO.DriveExists(mid(strLetters, i, 1) & ":") Then

 

            blnError = False

 

            GetFirstFreeDriveLetter = mid(strLetters, i, 1) & ":"

 

            Exit For

        End If

    Next

 

end Function

 

 

Sub CreateFolder( strPath )

Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")

On Error Resume Next

If strPath <> "" Then

If Not objFSO.FolderExists( objFSO.GetParentFolderName(strPath) ) then Call CreateFolder( objFSO.GetParentFolderName(strPath) )

objFSO.CreateFolder( strPath )

End If

End Sub

 

 

Function Message(flg, msg, fname)

                if ( flg = INFO_OK ) then

     msgbox msg, vbInformation

                end if

                if ( flg = INFO_OKCANCEL ) then

                Message = Msgbox ( msg, vbOKCancel+vbExclamation)

                end if

                if ( flg = PGM_ERR  ) then

                                msgbox "Errorno = " & Err.number & chr(13) & Err.Description, vbCritical

                end if

                if ( flg = SEND_ERR ) then

                                dim target

                                target = InStrRev(fname,"/") + 1

                                msgbox Mid(fname , target) & " : " & Xfer.Status & vbCrLf & msg , vbCritical

                end if

End Function

 

Function Initialize(flg)

                On Error Resume Next

                i = 0

                cnt = 1

                Set Xfer = Nothing

                Set File = Nothing

                Err.number = 0

                if flg <> "" then

                    Set File = CreateObject("ADODB.Stream")

                    Set Xfer = CreateObject("Msxml2.XMLHTTP")

     If Xfer Is Nothing Then 

         Set Xfer = CreateObject("Microsoft.XMLHTTP")

         Err.number = 0

     End If

                end if

end Function

 

-->

</script>

 

 

 

>

also please tell me in detail how to register dll's  

Any help is appreciated.

 

 

 

Answer 1

Hi Prashanth,

Thank you for posting.

Have you ever tried to debug the code snippet to see on which line the exception happens? I found that you use the CreateObject in three position, so could you tell me which statement produce the problem?

I assume that you encounter the problem when create the FileSystemObject, if so, please refer to these kb articles:

http://support.microsoft.com/kb/247979

http://support.microsoft.com/kb/200271

http://social.technet.microsoft.com/Forums/en/w7itprogeneral/thread/e4380048-4c84-4acb-ae5d-1c93579ad55d

As for registering dll, please refer to this kb article:

http://support.microsoft.com/kb/249873

Hope this can help you and just feel free to follow up after you have tried.

Best Regards,

---

Bruce Song [MSFT]
MSDN Community Support | Feedback to us

Answer 2

 Hi all

The above error occured due to some browser settings.

Got fixed when the settings were correct.No code correction !

In internet explorer , Go to tools -> internet options -> under "security" tab click on "trusted sites" and then click on the button "sites" under it and give add and close that small window which was open

Under the same security tab, at the bottom click on the button "Custom level". This will open a new window called "Security Settings - Trusted Sites Zone"

Under "ActiveX controls and plug-ins" please enable the following :

a. Download signed ActiveX controls

b. Download unsigned ActiveX controls

c. Initialize and script ActiveX controls not marked as safe for scripting.

Under "Miscellaneous" please enable the following :

a. Access data sources across domains Thanks and regards R Prashanth kumar