PDA

Vollständige Version anzeigen : Autoopenmakro ändern


derek47
08.09.2011, 13:15
Hallo Excel-Spezies!
Hoffe inständig auf Eure Hilfe. Ausgangsituation: 1 Ordner mit 2 Dateien (a1234567.dat und p1234567.xls). Die Zieldatei (p1234567.xls) enthält ein Autoopenmakro, dass aus der anderen Datei (a1234567.dat) Daten einliest und diese in die Tabelle mit dem Namen "input" einfügt. Voraussetzung, dass dieses klappt: Beide Dateinamen müssen mit a bzw. p beginnen und eine identische 7-stellige Ziffer haben.
Leider bin ich nicht in der Lage das Makro so abzuändern, dass auch Dateinamen, die mehr als 7 Ziffern haben genutzt werden können.
Mein konkreter Wunsch wäre, dass alle Dateinamen, beginnend mit "a" und anschliessender 7 oder 10 stelliger Ziffer auch funktionieren und zwar wieder passend zur Excel-Datei, die dann auch p+7 oder +10 Ziffern haben soll/kann.
Ich hoffe, ich habe mich verständlich ausgedrückt.... Please help
Sub auto_open()
Dim i As Integer
Dim j As Integer
Dim l As Integer
Dim s As String
Dim c As Currency
Dim d As String
Dim p As String
Dim td As String
Dim tt As String

On Error GoTo Tschau
td = Application.International(xlDecimalSeparator)
tt = Application.International(xlThousandsSeparator)
d = ActiveWorkbook.FullName
l = Len(d)
p = Mid$(d, l - 10, 7)
d = Left$(d, l - 12) + "A" + p + ".DAT"
Open d For Input As #1
i = 0
With Worksheets("Input")
Do While Not EOF(1)
Line Input #1, s
i = i + 1
If i > 6 Then
If td <> "," Or tt <> "." Then
For j = 1 To Len(s)
If Mid$(s, j, 1) = "," Then
Mid$(s, j, 1) = td
Else
If Mid$(s, j, 1) = "." Then
Mid$(s, j, 1) = tt
End If
End If
Next
End If
c = s
.Cells(i, 1).Value = c
Else
.Cells(i, 1).Value = s
End If
Loop
End With
Close #1
Worksheets("Tabelle").Activate

Tschau:
End Sub

Viele Grüße
Derek

Rudi Maintaire
08.09.2011, 20:40
Hallo,
sollte so klappen:
.....
On Error GoTo Tschau
td = Application.International(xlDecimalSeparator)
tt = Application.International(xlThousandsSeparator)
d = ActiveWorkbook.Name
l = Len(d)
p = Mid$(d, l - 10, 7)
d = ActiveWorkbook.Path & "\" & "a" & Mid(d, 2, Len(d) - 4) & ".dat"
Open d For Input As #1
.......
Gruß
Rudi

derek47
08.09.2011, 21:32
Danke Rudi für den Versuch. Hat leider nicht geklappt....
Hab mal folgendes versucht:
p = Mid$(d, l - 13, 10)
d = Left$(d, l - 15) + "A" + p + ".DAT"
anstatt:
p = Mid$(d, l - 10, 7)
d = Left$(d, l - 12) + "A" + p + ".DAT"

Tatsächlich wurden die Daten nun aus einem Dateinamen a1234567001.dat in die p1234567001.xls übertragen.
Nur leider weiß ich immer noch nicht, wie ich es schaffe, dass dieses Makro für Dateinamen mit 7 Ziffern sowie auch für welche mit 10 Ziffern funktioniert. Kann man irgendwie ein "oder" einbauen. Bin für jeden Tipp dankbar.
Schönen Abend noch
Derek

Rudi Maintaire
08.09.2011, 22:24
Hallo,
was geht nicht? Fehlermeldung?

Gruß
Rudi

Hasso
09.09.2011, 15:12
Hallo derek,

versuchs mal mit
p=Mid$(d, 2, l-5)

derek47
10.09.2011, 20:16
Hallo Rudi, Hallo Hasso,
sorry hatte so viel Stress zwischenzeitlich.
Also Fehlermeldung gab es keine. Es wurden einfach keine Daten einlesen.
Hasso der Versuch mit p=Mid$(d, 2, l-5) hat auch nix bewirkt, weder das Einlesen der Daten noch eine Fehlermeldung.
Vielleicht hab ich ja auch an der falschen Stelle geändert?
Makro sieht nun so aus:
td = Application.International(xlDecimalSeparator)
tt = Application.International(xlThousandsSeparator)
d = ActiveWorkbook.FullName
l = Len(d)
p = Mid$(d, 2, l - 5)
d = Left$(d, l - 15) + "A" + p + ".DAT"
Wenn ich das Zeug nur verstehen würde, wer kann bitte helfen?
Grüsse
Derek

derek47
11.09.2011, 00:40
Hi Leute,
eine schlaflose Nacht ....
Hab mal folgendes probiert:
td = Application.International(xlDecimalSeparator)
tt = Application.International(xlThousandsSeparator)
d = ActiveWorkbook.FullName
l = Len(d)
If l = 12 Then
p = Mid$(d, l - 10, 7)
d = Left$(d, l - 12) + "A" + p + ".DAT"
Else
p = Mid$(d, l - 13, 10)
d = Left$(d, l - 15) + "A" + p + ".DAT"
End If
Ich wollte damit formulieren, dass bei einer Gesamtlänge des Dateinamens von 12 Zeichen die obere Variante abgearbeitet werden soll und bei mehr Zeichen dann eben die Else-Variante. Sorry bin völlig diletantisch was VBA angeht. Das Makro arbeitet immer nur die Else-Variante ab, also in den Fällen, wo die Dateinamen jeweils insgesamt 15 Stellen haben. Die mit den 12 Stellen werden ignoriert. Was macht ich nur falsch?
Habt Erbarmen mit einem VBA Dummy
LG Derek

Hasso
11.09.2011, 08:32
Hallo derek47,

dir ist wohl nicht klar, dass ActiveWorkbook.FullName den kompletten Pfad der Datei enthält - und der ist wohl in deinem Fall immer größer als 12 Zeichen.
Versuch's mal mit ActiveWorkbook.Name.

derek47
11.09.2011, 17:46
Hallo Hasso,
danke Dir für die Aufklärung. Leider hilft das auch nicht. Sobald ich auf
ActiveWorkbook.Name abgeändert habe läuft auch das Else nicht mehr.
Fehlermeldungen gibt es keine, es passiert einfach nichts.
Was nun?
VG Derek

Hasso
11.09.2011, 18:09
Hallo Derek,

dann lade doch mal beide Dateien hoch. Sonst stochern wir noch wochenlang im Nebel.

derek47
11.09.2011, 22:26
Hallo Derek,

dann lade doch mal beide Dateien hoch. Sonst stochern wir noch wochenlang im Nebel.

Hallo Hasso,
hier sind die beiden. Die .dat musste ich in .txt umbenennen, um sie hochladen zu können.
Habe 12stellige Namen verwendet, weil diese nicht gehen. Sobald
die Dateinamen 15stellig (also z.B. p1234567001.xls und a1234567001.dat) sind, funktioniert das Einlesen.
Bin Dir echt dankbar, dass Du reinschauen willst.
Grüsse
Derek

Hasso
12.09.2011, 09:18
Hallo derek,

wenn du uns die Dateien etwas früher hochgeladen hättest, wäre dir viel Frust und uns viel Arbeit erspart worden.

Meine Vorschläge, die ich bisher gemacht hatte, hast du ja überhaupt nicht probiert.

Solche Konstruktionen
d = Left$(d, l - 12) + "A" + p + ".DAT"
zeigen, dass du noch einige Grundlagen lernen musst. Einen String kannst du nicht mit Pluszeichen zusammenbauen, sondern da gehört das kaufmännische & hin!

Ich hab das Makro mal etwas umgeschrieben und das funktioniert bei mir.


Sub auto_open()
Dim i As Integer
Dim j As Integer
Dim l As Integer
Dim s As String
Dim c As Currency
Dim d As String
Dim p As String
Dim td As String
Dim tt As String
Dim pfad As String

On Error GoTo Tschau
td = Application.International(xlDecimalSeparator)
tt = Application.International(xlThousandsSeparator)
d = ActiveWorkbook.Name
pfad = ActiveWorkbook.Path
l = Len(d)
p = Mid$(d, 2, l - 5)
d = pfad & "\a" & p & ".DAT"

Open d For Input As #1
i = 0
With Worksheets("Input")
Do While Not EOF(1)
Line Input #1, s
i = i + 1
If i > 6 Then
If td <> "," Or tt <> "." Then
For j = 1 To Len(s)
If Mid$(s, j, 1) = "," Then
Mid$(s, j, 1) = td
Else
If Mid$(s, j, 1) = "." Then
Mid$(s, j, 1) = tt
End If
End If
Next
End If
c = s
.Cells(i, 1).Value = c
Else
.Cells(i, 1).Value = s
End If
Loop
End With
Close #1
Worksheets("Tabelle").Activate

Tschau:
End Sub

derek47
12.09.2011, 12:42
Hallo Hasso,
Du hast mein Leben gerettet! Tausend Dank.
Bitte glaube mir, ich hatte Deine Vorschläge probiert, sie dann aber wieder rausgelöscht, weil sie nicht gingen.....
Habe normalerweise nichts mit VBA zu tun. Diese Datei hatte ich geerbt und versucht, eine Änderung (ohne VBA-Kenntnisse zu haben) durchzuführen.
Dieses d = Left$(d, l - 12) + "A" + p + ".DAT"
stand da so drin!?
Also nochmals herzlichen Dank für Deine Geduld und Unterstützung!
VG
Derek

Hasso
12.09.2011, 12:49
Du hast mein Leben gerettet! Tausend Dank

War mir ein Vergnügen :D