AW: Regsvr32.exe abfragen
20.11.2007 21:36:40
Ramses
Hallo
schau mal ob du das brauchen kannst
'Setzen aller benötigten Verweise
'Häufig gebrauchte Verweise "References" setzen
'Const erweitert von Ramses
'Verweise anpassen und Variablen im Code anpassen
Dim isRef As Boolean, i As Integer, link As Object
Const strExcel9 As String = "{00020813-0000-0000-C000-000000000046}" 'Microsoft Excel 9.0 Objects Library (Excel2000)
Const strExcel10 As String = "{00024500-0000-0000-C000-000000000046}" 'Microsoft Excel 10.0 Objects Library (Excel XP)
Const strExcel11 As String = "{00020813-0000-0000-C000-000000000046}" 'Microsoft Excel 11.0 Object Library (Excel 2003)
Const strWord8 As String = "{00020900-0000-0000-C000-000000000046}" 'Microsoft Word 8.0 Objects Library (Word 97)
Const strWord9 As String = "{00020905-0000-0000-C000-000000000046}" 'Microsoft Word 9.0 Objects Library (Word 2000)
Const strWord10 As String = "{000209FF-0000-0000-C000-000000000046}" 'Microsoft Word 10.0 Objects Library (Word XP)
Const strWord11 As String = "{00020905-0000-0000-C000-000000000046}" 'Microsoft Word 11.0 Object Library (Word 2003)
Const strMSOff11 As String = "{2DF8D04C-5BFA-101B-BDE5-00AA0044DE52}" 'Microsoft Office 11.0 Object Library
Const strOutlook9 As String = "{00062FFF-0000-0000-C000-000000000046}" 'Microsoft Outlook 9.0 Objects Library (Outlook 2000)
Const strOutlook10 As String = "{00020D75-0000-0000-C000-000000000046}" 'Microsoft Outlook 10.0 Objects Library (Outlook XP)
Const strOutlook11 As String = "{00062FFF-0000-0000-C000-000000000046}" 'Microsoft Outlook 11.0 Object Library (Outlook 2003)
Const strDAO As String = "{00025E01-0000-0000-C000-000000000046}" 'Microsoft DAO 3.6 Objects Library (DAO)
Const strADOX As String = "{00000600-0000-0010-8000-00AA006D2EA4}" 'ADO Ext. 2.1 for DDL And Security (ADOX)
Const strADO As String = "{00000201-0000-0010-8000-00AA006D2EA4}" 'Microsoft ActiveX Data Objects Library 2.1 (ADO)
Const strScript As String = "{420B2830-E718-11CF-893D-00A0C9054228}" 'Microsoft Scripting Runtime (WSH, FileSystemObject)
Const strVBA As String = "{000204EF-0000-0000-C000-000000000046}" 'Visual Basic for Application
Const strMSF20 As String = "{0D452EE1-E08F-101A-852E-02608C4D0BB4}" 'Microsoft Forms 2.0 Object Library
Const strWComCon As String = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}" 'Windows Common Controls 6.0 SP6
Const strAcroDist As String = "{317DA881-ECC5-11D1-B976-00600802DB86}" 'Acrobat Distiller
Sub SetReference(ref As String)
With Application.VBE.ActiveVBProject.References
' Aktuelle gesetzte Verweise durchgehen
On Error GoTo KillRef
i = 0: Do: i = i + 1: isRef = .Item(i).Name = ref: Loop Until i% >= .Count Or isRef
If isRef Then
If .Item(ref).IsBroken Then ' Verweis ungültig
.Remove .Item(ref)
Else ' Verweis ist bereits gesetzt
GoTo Sub_Exit
End If
End If
On Error GoTo Err_Check:
' Verweise entsprechend der Registry GUID setzen
If ref = "DAO" Then Set link = .AddFromGuid(strDAO, 5, 0)
If ref = "ADOX" Then Set link = .AddFromGuid(strADOX, 2, 1)
If ref = "ADO" Then Set link = .AddFromGuid(strADO, 2, 1)
If ref = "Script" Then Set link = .AddFromGuid(strScript, 1, 0)
If ref = "Excel" Then Set link = .AddFromGuid(strExcel, 1, 1)
If ref = "Word" Then Set link = .AddFromGuid(strWord, 8, 1)
If ref = "Outlook" Then Set link = .AddFromGuid(strOutlook, 9, 0)
Sub_Exit:
Set link = Nothing
End With
Exit Sub
Err_Check:
' Namenskonflikt mit Verweistabelle or Index außerhalb Bereich
If Err.Number = 32813 Or Err.Number = 9 Then
Resume Next
Else
MsgBox "Error Number : " & Err.Number & vbCrLf & Err.Description
GoTo Sub_Exit:
End If
KillRef:
With Application.VBE.ActiveVBProject.References
If .Item(i).IsBroken Then .Remove .Item(i)
End With
Resume Next
End Sub
Sub Install_Reference()
SetReference (strWComCon)
End Sub
Sub Show_References()
'(C) Ramses
Dim i As Integer
'On Error Resume Next
With ThisWorkbook.VBProject.References
For i = 1 To .Count
ActiveSheet.Cells(i, 1) = .Item(i).GUID
ActiveSheet.Cells(i, 2) = .Item(i).Description
ActiveSheet.Cells(i, 3) = .Item(i).Major
ActiveSheet.Cells(i, 4) = .Item(i).Minor
Next
End With
End Sub
Sub SetReference_to_FM20DLL()
On Error GoTo err_message
With Application.VBE.ActiveVBProject.References
.AddFromFile "C:\Windows\system32\fm20.dll"
End With
Exit Sub
err_message:
Select Case Err.Number
Case 32813
'Der Verweis existiert bereits
Case Else
MsgBox Err.Number & vbCrLf & Err.Description, vbCritical + vbOKOnly, "Fehler"
Exit Sub
End Select
End Sub
Gruss Rainer