Prozedur zu groß
21.06.2018 11:50:31
Thorsten
ich habe eine zu groß geratene VBA-Prozedur (also Code der größer als 64 KB ist).
Grundsätzlich ist das vermutlich nicht problematisch. Allerdings ist die Aufgabe recht komplex. Es müssen aus verschiedenen Word-Dokumenten klar definierte Inhaltssteuerlemente identifizieren und ausgelesen werden. Dafür wird Word nicht wirklich geöffnet, bzw. unmittelbar nach dem Auslesevorgang wieder geschlossen (Die Inhaltssteuerelemente sind immer in 10er-Schritten einzeln benannt - also z.B. SE1, SE2,SE3 etc... insgesamt werden in jedem Dokument 6 x 60 Elemente ausgelesen). Das alles funktioniert bis zu einer gewissen Größe (6 x40) auch tadellos. Nun sind allerdings ein paar Inhaltssteuerelemente hinzugekommen (eben 6x60) und ich habe das Problem mit der zu großen Prozedur..Prozedur teilen funktioniert aber nicht, da es vor lauter For/If befehlen am Anfang und am Ende nur so wimmelt. Ich habe in diesem Forum auch schon gefragt, ob der Einbau von Schleifen möglich ist. Trotz guter Vorschläge hat das leider nicht funktioniert.
Meine Frage: Wo muss ich die Prozedur teilen? Welche For/if-Befehle muss ich zwischendurch evt. beenden und neu aufrufen?
Ich kopiere hier mal den (wesentlichen) Code rein, da die Datei für ein Upload zu groß ist.
_
Sub btnImportForms1()
On Error Resume Next
Dim ws As Worksheet, lo As ListObject, objWord As Object, doc As Object, cXML As _
CustomXMLPart, myXMLPart As CustomXMLPart, dlg As FileDialog
'Tabelle im Dokument referenzieren
Set ws = Worksheets(1)
'List-Object Tabelle mit Namen referenzieren
Set lo = ws.ListObjects("MeineDatenTabelle")
'Word Objekt erzeugen
Set objWord = CreateObject("Word.Application")
objWord.Visible = False
objWord.DisplayAlerts = False
'Dateiauswahl-Dialog erstellen
Set dlg = Application.FileDialog(msoFileDialogFilePicker)
With dlg
'Einstellungen für den Dialog setzen
.AllowMultiSelect = True
.Title = "Bitte markieren sie ein oder mehere Formulare deren Daten importiert werden _
_
_
sollen"
.Filters.Add "Word Dateien", "*.docx; *.docm", 1
.FilterIndex = 1
' Wenn der Dialog mit OK geschlossen wurde mache weiter
If .Show = -1 Then
' Für jedes Dokument das im Dialog ausgewählt wurde ..
For i = 1 To .SelectedItems.Count
'Öffne das Dokument
Set doc = objWord.Documents.Open(.SelectedItems(i))
' Suche das CustomXML im Dokument
For Each cXML In doc.CustomXMLParts
If cXML.BuiltIn = False Then
Set rootNode = cXML.SelectSingleNode("root")
If Not rootNode Is Nothing Then
Set myXMLPart = cXML
Exit For
End If
End If
Next
'Wenn der CustomXML-Part gefunden wurde ...
If Not myXMLPart Is Nothing Then
'Formularfelder zu Variablen zuordnen
strHPZielNr = myXMLPart.SelectSingleNode("/root/HPZielNr").Text
strpkHilfe = myXMLPart.SelectSingleNode("/root/pkHilfe").Text
strDatum = myXMLPart.SelectSingleNode("/root/Datum").Text
strKi0 = myXMLPart.SelectSingleNode("/root/Ki0").Text
strKi1 = myXMLPart.SelectSingleNode("/root/Ki1").Text
etc..
AB JETZT FOLGEN ZWEI MAL 360 ZEILEN ZUM AUSLESEN BZW. ZUM ÜBERTRAGEN DER ERGEBNISSE
DAS ENDE SCHAUT DANN FOLGENDERMASSEN AUS:
lo.ListRows(lo.ListRows.Count).Range(1, 45).Value = strSD8f
lo.ListRows(lo.ListRows.Count).Range(1, 46).Value = strSD9f
lo.ListRows(lo.ListRows.Count).Range(1, 47).Value = strSD10f
End If
'Dokument schließen
doc.Close False
Next
End If
End With
'Word schließen
objWord.DisplayAlerts = False
objWord.Quit
Set objWord = Nothing
End Sub
Tja, vielleicht hat ja jemand eine Idee. Wie kriege ich diese Monster-Prozedur geteilt?