运行时错误“429”：ActiveX组件无法创build对象

我希望你能帮上忙。 我明白这个问题已经被问了很多，我希望我不会被拒绝。 但我已经尝试了几种使用在线资源解决这个问题的方法，但是我现在没有解决办法，需要帮助。

正如我所面对的标题所述

运行时错误'429'：ActiveX组件不能创build对象

我可以告诉你的是：我已经安装了64位版本，并且对于我和我在都柏林的团队来说，Macro有问题，但使用64位版本的其他欧洲办事处也会得到429错误。

请参阅图1系统信息。 64位必须保持安装32Bit不是一个选项

我已经尝试了所有可用的选项在这里http://www.fixyourerrors.com/how-can-i-get-rid-of-runtime-error-429/

但没有成功，从上面的链接说明。

我已经检查过所有相应的Active X控件在Excel的VBA开发人员区域/库的工具，参考，区域中打勾请参阅图2

但是再次没有影响:-(

图1

图2

正在发生错误的代码在下面

' ***************************************************************************** ' Management of File to write in UT8 format ' ***************************************************************************** ' This function open the file indicated to be able to write inside Private Sub OUTFILE_OPEN(filename As String) Set WriteObject = CreateObject("ADODB.Stream") WriteObject.Type = 2 'Specify stream type - we want To save text/string data. WriteObject.Charset = "utf-8" 'Specify charset For the source text data. WriteObject.Open 'Open the stream And write binary data To the object OUTFilename = filename End Sub 

而429错误正在发生的是

 Set WriteObject = CreateObject("ADODB.Stream") 

正如我所说，我试图解决这个问题，但我现在是一个死路一条决议。 我的代码可以修改，或者有一些技巧可以解决这个问题吗？

与往常一样，所有的帮助，不胜感激。

完整的代码

 'Variables for Deduplication Dim WB_Cust As Workbook 'File Variables Dim DTOV_Directory As String Dim DTOV_File As String Dim ITOV_Directory As String Dim ITOV_file As String Const DELIMITER As String = "|" ' Variables for writing text into file Dim WriteObject As Object Dim OUTFilename As String Dim MyWkBook As Workbook Dim MyWkSheet As Worksheet Dim OutputFile As String ' Output flat file name Dim SysCode As String ' Variable for text string of system code to be filled into information system code column Dim strFilenameOut As String ' Variable for name of file being processed. It is used for SysCode and OutputFile determination. Dim CustAddressSave As Range 'Processing of one file. This procedure is called when only one of file types are selected Public Sub Process_template(Directory As String, File As String, FileFlag As String) Application.ScreenUpdating = False 'Turns off switching of windows If FileFlag = "D" Then 'Variables setup for DTOV DTOV_Directory = Directory DTOV_File = File ElseIf FileFlag = "I" Then 'Variables setup for ITOV ITOV_Directory = Directory ITOV_file = File Else MsgBox "Unhandled Exception - Unknown files sent" Exit Sub End If Call Process(1, FileFlag) Application.ScreenUpdating = True 'Turns On switching of windows End Sub 'Processing of two file. This procedure is called when both file types are to be processed Public Sub Process_Templates(DTOV_Dir As String, DTOV_Fil As String, ITOV_Dir As String, ITOV_Fil As String) Application.ScreenUpdating = False 'Turns off switching of windows DTOV_Directory = DTOV_Dir DTOV_File = DTOV_Fil ITOV_Directory = ITOV_Dir ITOV_file = ITOV_Fil Call Process(2, "B") Application.ScreenUpdating = True 'Turns on switching of windows End Sub ' ***************************************************************************** ' Management of File to write in UT8 format ' ***************************************************************************** ' This function open the file indicated to be able to write inside Private Sub OUTFILE_OPEN(filename As String) Set WriteObject = CreateObject("ADODB.Stream") WriteObject.Type = 2 'Specify stream type - we want To save text/string data. WriteObject.Charset = "utf-8" 'Specify charset For the source text data. WriteObject.Open 'Open the stream And write binary data To the object OUTFilename = filename End Sub ' This function closes the file Private Sub OUTFILE_CLOSE() WriteObject.SaveToFile OUTFilename, 2 WriteObject.Close ' Close the file End Sub ' Write a string in the outfile Private Sub OUTFILE_WRITELINE(txt As String) WriteObject.WriteText txt & Chr(13) & Chr(10) txt = "" End Sub ' subprocedure to read TOV data into stream and call procedure to generate file Public Sub generate_tov(i_Sheet_To_Process As String, _ i_OffsetShift As Integer) Dim sOut As String ' text to be written into file 'Set OutputFile = "sarin" Sheets(i_Sheet_To_Process).Select Range("C2").Select 'Parsing of system code from filename strFilenameOut = ActiveWorkbook.Name 'example - initial file name: EFPIA_DTOV-BE-MTOV-201503271324.xlsx SysCode = Left(strFilenameOut, InStrRev(strFilenameOut, "-") - 1) 'example - after LEFT cut EFPIA_ITOV-BE-MTOV SysCode = Right(SysCode, Len(SysCode) - InStrRev(SysCode, "-")) 'example - after RIGHT cut MTOV Do Until (IsError(ActiveCell.Offset(0, 1).Value) = True) If ActiveCell.Offset(0, 1).Value = "" Then 'end-of-file reached, hence exist the do loop Exit Do End If ActiveCell.Value = SysCode ActiveCell.Offset(0, i_OffsetShift).Value = Application.WorksheetFunction.VLookup(Sheets("Template - EFPIA Customer").Cells(ActiveCell.Row, 3).Value, Sheets("Appendix").Range("N1:O103"), 2, "FALSE") & "_" & ActiveCell.Offset(0, i_OffsetShift).Value ActiveCell.Offset(1, 0).Select Loop OutputFile = Left(strFilenameOut, InStrRev(strFilenameOut, ".") - 1) & ".txt" If (IsError(ActiveCell.Offset(0, 1).Value) = True) Then MsgBox ("incorrect data in the TOV source file. Please correct and re-run the macro") Exit Sub Else Call generate_file End If End Sub ' procedures to write stream data into file for both TOV and customer Public Sub generate_file() Dim X As Integer Dim Y As Long Dim FieldValue As String Dim NBCol As Integer Dim sOut As String ' text to be written into file OUTFILE_OPEN (OutputFile) 'Open (setup) the output file 'Open OutputFile For Output As #1 'Prepares new file for output Set MyWkBook = ActiveWorkbook Set MyWkSheet = ActiveSheet NBCol = 0 Do While (Trim(MyWkSheet.Cells(1, NBCol + 1)) <> "") NBCol = NBCol + 1 Loop ' Scroll all rows Y = 1 Do While (Trim(MyWkSheet.Cells(Y, 4)) <> "") sOut = "" For X = 1 To NBCol ' here, if required, insert a convertion type function FieldValue = Trim(MyWkSheet.Cells(Y, X)) FieldValue = Replace(FieldValue, "|", "/") 'Replaces pipes from input file to slashes to avoid mismatches during ETL If FieldValue = "0" Then FieldValue = "" 'Replaces "only zeroes" - might need redoing only for amount columns If InStr(MyWkSheet.Cells(1, X), "Amount") > 0 Then FieldValue = Replace(FieldValue, ",", ".") ' add into the string If X = NBCol Then sOut = sOut & FieldValue Else sOut = sOut & FieldValue & DELIMITER End If Next X Y = Y + 1 OUTFILE_WRITELINE sOut Loop OUTFILE_CLOSE End Sub ' read the customer data into stream Public Sub read_customer(i_Sheet_To_Process As String, _ i_range As String) Dim CCST As Workbook ' Variable to keep reference for template Workbook that is being used for copy-paste of Customer data into virtuall Workbook Sheets(i_Sheet_To_Process).Select ActiveSheet.UsedRange.Copy Set CCST = ActiveWorkbook WB_Cust.Activate If i_range = "" Then Sheets("Sheet1").Range(CustAddressSave.Address).PasteSpecial xlPasteValues Range(CustAddressSave.Address).Select ActiveCell.Offset(0, 2).Select Rows(CustAddressSave.Row).EntireRow.Delete Else Sheets("Sheet1").Range("A1").PasteSpecial xlPasteValues Range("C2").Select End If 'Call LookingUp(CCST) Do Until (IsError(ActiveCell.Offset(0, 1).Value) = True) If ActiveCell.Offset(0, 1).Value = "" Then 'end-of-file reached, hence exist the do loop Exit Do End If ActiveCell.Offset(0, 1).Value = Application.WorksheetFunction.VLookup(ActiveCell.Offset(0, 0).Value, CCST.Sheets("Appendix").Range("N1:O103"), 2, "FALSE") & "_" & ActiveCell.Offset(0, 1).Value ActiveCell.Value = SysCode ActiveCell.Offset(1, 0).Select Loop If (IsError(ActiveCell.Offset(0, 1).Value) = True) Then MsgBox ("incorrect data in the source file. Please correct and re-run the macro") Exit Sub Else Set CustAddressSave = ActiveCell.Offset(0, -2) 'Saves position where 2nd Cust data sheet will be copied OutputFile = Left(Mid(strFilenameOut, 1, (InStr(strFilenameOut, "_"))) & "CUST" & Mid(strFilenameOut, (InStr(strFilenameOut, "-"))), InStrRev(strFilenameOut, ".") - 1) & ".txt" End If End Sub 'Main Procedure of the module that processes the files Private Sub Process(Loops As Integer, FileFlag As String) 'Loops - number of files (1 or 2), FileFlag - which file is to be processed (I - ITOV, D - DTOV, B - Both) Set WB_Cust = Workbooks.Add ' This virtual workbook is created only for duration of the processing. It is used to copy paste CUSTOMER data form one or both templates. If FileFlag = "D" Or FileFlag = "B" Then ' process DTOV first always Call Open_DTOV '---------------------------------------------------------- Call generate_tov("Template - Transfer of Value", 3) ' if the file have data issues, then abort the procedure. If (IsError(ActiveCell.Offset(0, 1).Value) = True) Then GoTo HandleException End If '---------------------------------------------------------- Call read_customer("Template - EFPIA Customer", "A") ' if the file have data issues, then abort the procedure. If (IsError(ActiveCell.Offset(0, 1).Value) = True) Then GoTo HandleException End If End If If FileFlag = "I" Or FileFlag = "B" Then Call Open_ITOV '---------------------------------------------------------- Call generate_tov("Template - EFPIA iToV", 17) ' if the file have data issues, then abort the procedure. If (IsError(ActiveCell.Offset(0, 1).Value) = True) Then GoTo HandleException End If '---------------------------------------------------------- If FileFlag = "B" Then Call read_customer("Template - EFPIA Customer", "") Else Call read_customer("Template - EFPIA Customer", "A") End If ' if the file have data issues, then abort the procedure. If (IsError(ActiveCell.Offset(0, 1).Value) = True) Then GoTo HandleException End If End If Call Deduplicate Call generate_file ' generate single customer file MsgBox "Export Process is completed" HandleException: ' Closes the virtual workbook used for consolidation and deduplication of customers WB_Cust.Saved = True WB_Cust.Close ActiveWorkbook.Saved = True 'Closes Template ActiveWorkbook.Close (False) If Loops = 2 Then 'Closes second Template if two files are being processed ActiveWorkbook.Saved = True ActiveWorkbook.Close (False) End If Application.ScreenUpdating = True 'Turns back on switching to exported excel file once it gets opened Exit Sub End Sub 'Unused Procedure to reduce Customer data processing code. Does not work now. Private Sub LookingUp(CCST As Workbook) Do Until (ActiveCell.Offset(0, 1).Value = "") ActiveCell.Offset(0, 1).Value = Application.WorksheetFunction.VLookup(ActiveCell.Offset(0, 0).Value, CCST.Sheets("Appendix").Range("N1:O103"), 2, "FALSE") & "_" & ActiveCell.Offset(0, 1).Value ActiveCell.Value = SysCode ActiveCell.Offset(1, 0).Select Loop End Sub 'Open DTOV Template Private Sub Open_DTOV() Workbooks.Open (DTOV_Directory + DTOV_File) End Sub 'Open ITOV Template Private Sub Open_ITOV() Workbooks.Open (ITOV_Directory + ITOV_file) End Sub 'Deduplicating Customer data based on Source_Party_Identifier, which already contains source code prefix Private Sub Deduplicate() ActiveSheet.UsedRange.RemoveDuplicates Columns:=4, Header:=xlYeas End Sub