Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1076to1080
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

AddIn für CSV-Import

AddIn für CSV-Import
21.05.2009 08:55:52
Goofe
Hallo zusammen,
ich muss eine standardisierte CSV-Datei importieren. Dies mache ich in Excel über Daten, externe Daten importieren, usw. Der Dateiname beginnt immer mit URML...csv.
Bei dem nun sich öffnenden Text-Assistent muss ich "getrennt" dann "Tabstopp" und "Komma" aktivieren. Immer nach dem gleichen Schema. Nach dem Fertigstellen wird die Tabelle in A1 beginnend dargestellt. Das wäre das 1. Prozedere, welches ich über ein AddIn abwickeln möchte. Das 2. Prozedere (Formatierung, Sortierung, Berechnung, etc.) habe ich bereits erfolgreich über ein Makro dargestellt. Dies muss ich dann immer über "Extras", "Makros", usw. ausführen lassen.
Nun möchte ich quasi ein AddIn, welches das o.g. 1. Prozedere abdeckt und in diesem AddIn möchte ich dann folglich auch meinen Makro-Text für das 2. Prozedere integrieren.
Das AddIn soll immer dann Starten, wenn ich eine CSV-Datei öffne (über den Explorer oder aus Excel heraus), deren Name mit URML beginnt. Ich habe schon einmal so etwas gesehen, wie: bei dieser Datei scheint es sich um eine URML-Datei zu handeln. Möchten Sie die CSV-Datei mit dem URML-AddIn importieren, JA/NEIN?
Wie müsste also der komplette VBL-AddIn-Text aussehen (Ausnahme mein Makro-Text), damit folgende Kriterien abgedeckt sind:
1.) Beim Öffnen der CSV-Datei mit URML-beginnend: Fragedialog "Möchten Sie die Datei mit dem URML-AddIN" öffnen?
2.) Wenn ja: Import nach "getrennt", "Tabstopp", "Komma"; Tabellenstart in A1
3.) Wenn nein: es soll sich der Text-Assistent öffnen
4.) Nach dem Import (siehe Punkt 2) soll automatisch das Makro starten, welches ich in das AddIn integrieren möchte
Vielen Dank für Eure Unterstützung.
Viele Grüße.

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
der Anfang...
21.05.2009 09:43:35
Tino
Hallo,
habe hier mal einen Code zusammengebastelt.
Wird eine CSV geöffnet die dem Namen entspricht, kommt die abfrage mit der Msgbox.
Ist keine Exceldatei geöffnet, wird eine neue erstellt um die Daten zu Importieren.
Ist eine Exceldatei offen, werden die Daten in die gerade aktive Datei und Tabelle Importiert.
Man könnte dies noch weiter ausbauen, indem man eine abfrage einbaut wo die Daten hin sollen aber dies war erstmal nicht die Aufgabe.
Dein Makro musst Du nur noch entsprechend im Addin unter bringen und an der entsprechenden stelle im Code laufen lassen. (siehe Kommentar im Code)
kommt als Code in DieseArbeitsmappe
Option Explicit 
 
'In Arbeitsmappe 
Dim oKlasseExcel As Klasse1 
Private Sub Workbook_BeforeClose(Cancel As Boolean) 
   Set oKlasseExcel = Nothing 
End Sub 
 
Private Sub Workbook_Open() 
    Set oKlasseExcel = New Klasse1 
    Set oKlasseExcel.ExcelWatch = Application 
End Sub 
 
 
 

Modul Modul1

Option Explicit 
 
Sub Import_CSV(strFullName As String) 
Dim QuerTab As QueryTable 
     
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & strFullName, Destination:=Range("$A$1")) 
        .Name = "URML-CSV" 
        .FieldNames = True 
        .RowNumbers = False 
        .FillAdjacentFormulas = False 
        .PreserveFormatting = True 
        .RefreshOnFileOpen = False 
        .RefreshStyle = xlInsertDeleteCells 
        .SavePassword = False 
        .SaveData = True 
        .AdjustColumnWidth = True 
        .RefreshPeriod = 0 
        .TextFilePromptOnRefresh = False 
        .TextFilePlatform = 850 
        .TextFileStartRow = 1 
        .TextFileParseType = xlDelimited 
        .TextFileTextQualifier = xlTextQualifierDoubleQuote 
        .TextFileConsecutiveDelimiter = False 
        .TextFileTabDelimiter = True 
        .TextFileSemicolonDelimiter = False 
        .TextFileCommaDelimiter = True 
        .TextFileSpaceDelimiter = False 
        .TextFileColumnDataTypes = Array(1) 
        .TextFileTrailingMinusNumbers = True 
        .Refresh BackgroundQuery:=False 
    End With 
  
 For Each QuerTab In ActiveSheet.QueryTables 
  QuerTab.Delete 
 Next QuerTab 
 
End Sub 

Klassenmodul Klasse1

Option Explicit 
 
'in das Klassenmodul 
Public WithEvents ExcelWatch As Application 
 
Private Sub ExcelWatch_WorkbookOpen(ByVal Wb As Workbook) 
Dim strFullName As String 
Dim iCalc As Integer 
 If Wb.Name Like "URML*.csv" Then 
   
  If MsgBox("Möchten Sie die Datei: " & Wb.Name & " mit dem URML-AddIN öffnen?", vbYesNo, "CSV-Import") = vbYes Then 
    strFullName = Wb.FullName 
    ActiveWorkbook.Close False 
             
            With Application 
              
             'ist keine Exceldatei offen, wird eine neue erstellt. 
             If Workbooks.Count = 0 Then 
              Workbooks.Add 
             End If 
              
             iCalc = .Calculation 
             .ScreenUpdating = False 
             .EnableEvents = False 
             .Calculation = xlCalculationManual 
     
                Call Import_CSV(strFullName) 
                'hier kommt Dein anderes Makro 
                'Dies in ein Modul und mit Call ... aufrufen 
              
             .Calculation = iCalc 
             .ScreenUpdating = True 
             .EnableEvents = True 
            End With 
   
  End If 
 End If 
End Sub 


Gruß Tino

Anzeige
AW: der Anfang...
21.05.2009 10:08:25
Goofe
Hallo Tino,
das sieht mal sehr gut und auf den ersten Blick plausibel aus.
Werde es heute Abend ausprobieren und mich dann noch mal melden.
Vielen Dank schon mal Vorab.
Gruß,
Stefan
AW: der Anfang...
21.05.2009 17:43:42
Goofe
Hallo Tino,
habe es jetzt ausprobiert.
Es funktioniert ohne Probleme, wenn ich eine leere Excel-Arbeitsmappe geöffnet habe und aus Excel heraus die CSV-Datei öffne.
Wenn Excel allerdings geschlossen ist und ich die Datei aus dem Explorer öffnen möchte oder aber Excel geöffnet ist aber keine Arbeitsmappe, dann wird der Laufzeitfehler 13 angezeigt, "Typen unverträglich". Nach klick auf Debuggen wird ein Fehler bei "iCalc = .Calculation" im Klassenmodul angezeigt.
Hast Du hierfür eine Idee?
Danke schon mal im Voraus.
Gruß,
Stefan
Anzeige
Fehler gefunden.
21.05.2009 19:24:00
Tino
Hallo,
ok wahrscheinlich ist bei Dir die Persönlich Arbeitsmappe aktiviert.
Ersetze den Code im Klassenmodul mit diesem.
Option Explicit
 
'in das Klassenmodul 
Public WithEvents ExcelWatch As Application
 
Private Sub ExcelWatch_WorkbookOpen(ByVal Wb As Workbook)
Dim strFullName As String
Dim iCalc As Integer
Dim akWB As Workbook, booCheckWB As Boolean
 
 If Wb.Name Like "URML*.csv" Then
   
  If MsgBox("Möchten Sie die Datei: " & Wb.Name & " mit dem URML-AddIN öffnen?", vbYesNo, "CSV-Import") = vbYes Then
    strFullName = Wb.FullName
    ActiveWorkbook.Close False
  
            With Application
              
             'prüfen ob eine Exceldatei offen, sonst neue erstellen 
              For Each akWB In Workbooks
               If akWB.Name Like "*.xls*" And (Not UCase(akWB.Name) = "PERSONAL*") Then
                akWB.Activate: Exit For
                booCheckWB = True
               End If
              Next akWB

             If Not booCheckWB Then Workbooks.Add
             
             iCalc = .Calculation
             .ScreenUpdating = False
             .EnableEvents = False
             .Calculation = xlCalculationManual
     
                Call Import_CSV(strFullName)
                'hier kommt Dein anderes Makro 
                'Dies in ein Modul und mit Call ... aufrufen 
              
             .Calculation = iCalc
             .ScreenUpdating = True
             .EnableEvents = True
            End With
   
  End If
 End If
End Sub


Gruß Tino

Anzeige
Korrektur...
21.05.2009 19:27:02
Tino
Hallo,
muss nochmal nachkorrekieren.
Option Explicit
 
'in das Klassenmodul 
Public WithEvents ExcelWatch As Application
 
Private Sub ExcelWatch_WorkbookOpen(ByVal Wb As Workbook)
Dim strFullName As String
Dim iCalc As Integer
Dim akWB As Workbook, booCheckWB As Boolean
 
 If Wb.Name Like "URML*.csv" Then
   
  If MsgBox("Möchten Sie die Datei: " & Wb.Name & " mit dem URML-AddIN öffnen?", vbYesNo, "CSV-Import") = vbYes Then
    strFullName = Wb.FullName
    ActiveWorkbook.Close False
  
            With Application
              
             'prüfen ob eine Exceldatei offen, sonst neue erstellen 
              For Each akWB In Workbooks
               If akWB.Name Like "*.xls*" And (Not UCase(akWB.Name) = "PERSONAL*") Then
                booCheckWB = True
                akWB.Activate: Exit For
               End If
              Next akWB

             If Not booCheckWB Then Workbooks.Add
             
             iCalc = .Calculation
             .ScreenUpdating = False
             .EnableEvents = False
             .Calculation = xlCalculationManual
     
                Call Import_CSV(strFullName)
                'hier kommt Dein anderes Makro 
                'Dies in ein Modul und mit Call ... aufrufen 
              
             .Calculation = iCalc
             .ScreenUpdating = True
             .EnableEvents = True
            End With
   
  End If
 End If
End Sub


Gruß Tino

Anzeige
AW: Korrektur...
22.05.2009 12:46:10
Goofe
Hallo Tino,
vielen Dank für Deine Unterstützung, funktioniert jetzt ohne Probleme.
Schönes Wochenende.
Grüße,
Stefan

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige