05.11.2020, 10:50
Moin
nach langer (und erfolgloser) Recherche habe ich mich entschlossen mein Problem in diesem Forum darzustellen.
Ich habe eine Exceldatei bei der ich über einen Button eine Userform aktiviere. In dieser Userform werden alle geöffneten Exceldateien gelistet und der Benutzer soll eine auswählen. Aus der ausgewählten Datei wird das erste Tabellenblatt in diese Datei integriert. Es sollen aber nur Exceldateien gelistet werden, die keinen VBA-Code enthalten. Dafür habe ich mir eine Funktion geschrieben - check_code - die WAHR zurückgibt, wenn Code gefunden wurde.
Nach langem Ausprobieren bin ich auch so weit gekommen, dass die Funktion das tut was sie soll. ABER leider bekomme ich eine Situation nicht ordentlich abgefangen: die Überprüfung von Arbeitsmappen, die noch nie gespeichert wurden, also Mappe1.* Dateien. denn für diese Dateien gibt es (leider) keinen FileName. Ich habe erwartet, dass im FileName dann zumindest "Mappe1.xlsx" steht - Fehlanzeige.
Ich habe mir bisher so geholfen, dass ich solche Files über die Eigenschaft "BuildFileName" erkenne, da diese nur 14 Zeilen lang ist. Ist aber eine unschöne Lösung. Mir fehlt eine Möglichkeit vom ArbeitsmappenNamen (ThisWorkbook.Name oder Worksbooks(i).Name) auf das zugehörige VBProject zuzugreifen. Hätte ich dafür eine Lösung, könnte der Code deutlich einfacher aussehen.
Vielleicht hat ja jemand eine Idee.
(Ziel dieses Posts ist nicht meine Programmierfähigkeit zu beurteilen - ich weiß, dass ich kein Experte darin bin und man vermutlich einiges im Code professionell anders machen würde. Sollten grobe Schnitzer drin sein, bin ich über eine PM dankbar :63:)
Private Function check_code(dateiname As String)
Dim i As Integer
Dim j As Integer
If dateiname <> "" Then
check_code = False
For i = 1 To Application.VBE.VBProjects.Count
If Len(Application.VBE.VBProjects.Item(i).BuildFileName) > 14 Then
If InStr(Application.VBE.VBProjects.Item(i).Filename, dateiname) > 0 Then
For j = 1 To Application.VBE.VBProjects.Item(i).VBComponents.Count
If Application.VBE.VBProjects.Item(i).VBComponents.Item(j).CodeModule.CountOfLines > 0 Then
check_code = True
End If
Next
End If
ElseIf Len(Application.VBE.VBProjects.Item(i).BuildFileName) <= 14 Then
check_code = True
Exit Function
End If
Next
Else
resp = MsgBox("Datei '" & dateiname & "' existiert nicht.", vbOKOnly)
End If
End Function
nach langer (und erfolgloser) Recherche habe ich mich entschlossen mein Problem in diesem Forum darzustellen.
Ich habe eine Exceldatei bei der ich über einen Button eine Userform aktiviere. In dieser Userform werden alle geöffneten Exceldateien gelistet und der Benutzer soll eine auswählen. Aus der ausgewählten Datei wird das erste Tabellenblatt in diese Datei integriert. Es sollen aber nur Exceldateien gelistet werden, die keinen VBA-Code enthalten. Dafür habe ich mir eine Funktion geschrieben - check_code - die WAHR zurückgibt, wenn Code gefunden wurde.
Nach langem Ausprobieren bin ich auch so weit gekommen, dass die Funktion das tut was sie soll. ABER leider bekomme ich eine Situation nicht ordentlich abgefangen: die Überprüfung von Arbeitsmappen, die noch nie gespeichert wurden, also Mappe1.* Dateien. denn für diese Dateien gibt es (leider) keinen FileName. Ich habe erwartet, dass im FileName dann zumindest "Mappe1.xlsx" steht - Fehlanzeige.
Ich habe mir bisher so geholfen, dass ich solche Files über die Eigenschaft "BuildFileName" erkenne, da diese nur 14 Zeilen lang ist. Ist aber eine unschöne Lösung. Mir fehlt eine Möglichkeit vom ArbeitsmappenNamen (ThisWorkbook.Name oder Worksbooks(i).Name) auf das zugehörige VBProject zuzugreifen. Hätte ich dafür eine Lösung, könnte der Code deutlich einfacher aussehen.
Vielleicht hat ja jemand eine Idee.
(Ziel dieses Posts ist nicht meine Programmierfähigkeit zu beurteilen - ich weiß, dass ich kein Experte darin bin und man vermutlich einiges im Code professionell anders machen würde. Sollten grobe Schnitzer drin sein, bin ich über eine PM dankbar :63:)
Private Function check_code(dateiname As String)
Dim i As Integer
Dim j As Integer
If dateiname <> "" Then
check_code = False
For i = 1 To Application.VBE.VBProjects.Count
If Len(Application.VBE.VBProjects.Item(i).BuildFileName) > 14 Then
If InStr(Application.VBE.VBProjects.Item(i).Filename, dateiname) > 0 Then
For j = 1 To Application.VBE.VBProjects.Item(i).VBComponents.Count
If Application.VBE.VBProjects.Item(i).VBComponents.Item(j).CodeModule.CountOfLines > 0 Then
check_code = True
End If
Next
End If
ElseIf Len(Application.VBE.VBProjects.Item(i).BuildFileName) <= 14 Then
check_code = True
Exit Function
End If
Next
Else
resp = MsgBox("Datei '" & dateiname & "' existiert nicht.", vbOKOnly)
End If
End Function