getopenfilename probleme

Question

hallo zusammen,

bin eher ein anfänger was excel vba betrifft, dennoch muss ich hier jetz mal ein makro machen und benötige eure hilfe. mal kurz eine beschreibung was ich brauche:
eine bestehende Exceldatei soll mit PICS-Regeldateien gefüttert werden. das aufgezeichnete makro unten verarbeitet zwei testdateien "1" und "2" so wie ich es brauche..mein problem ist nun dass die dateien eigtl immer anders heißen und unterschiedlich viele sind. mit der funktion getopenfilename würde ich am liebsten manuell die dateien auswählen und das makro macht dann weiter wie gewünscht. allerdings muss es ja dann wissen wie die dateien heissen die ich ausgewählt habe?!?! naja, ich komm nicht weiter, wäre nett wenn jemand von euch einen vorschlag hat für mich!

gruß harry



Sub Makro2()
'
' Makro2 Makro
' files 2
'

'
ChDir "C:\Users\Harry\Desktop\test"
Workbooks.OpenText Filename:="C:\Users\Harry\Desktop\test\2.prf", Origin:= _
xlMSDOS, StartRow:=6, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote _
, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=True _
, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1)), _
TrailingMinusNumbers:=True
Workbooks.OpenText Filename:="C:\Users\Harry\Desktop\test\1.prf", Origin:= _
xlMSDOS, StartRow:=6, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote _
, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=True _
, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1)), _
TrailingMinusNumbers:=True
Range("A1:B1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("Spek_Vergleich.xls").Activate
Range("A5").Select
ActiveSheet.Paste
Windows("2.prf").Activate
Range("A1:B1").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Windows("Spek_Vergleich.xls").Activate
Range("D5").Select
ActiveSheet.Paste
Columns("G:R").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("N6").Select
ActiveWindow.SmallScroll ToRight:=-4
End Sub

Answer 1

Hi,

Sowas würde bei mir z.B. in etwa aussehen wie folgt:

Sub naLos()
Dim varFileNames As Variant
Dim lngCount As Long

varFileNames = Application _
.GetOpenFilename("PICS-Regeldateien (*.prf), *.prf", 1, "Datei wählen", , True) 'Filenamen holen
If VarType(varFileNames) = vbBoolean Then 'bei Abbruch
MsgBox "Keine Datei gewählt!" 'kleine Meldung
Exit Sub 'Makro Ende
End If

'ggf. hier gesamten Zielbereich löschen
For lngCount = LBound(varFileNames) To UBound(varFileNames) Step 1 'vom ersten bis zum letzten File
MsgBox ("File " & varFileNames(lngCount) & " wird verarbeitet") 'Meldung hier nur als Beispielcode
'===========
'PSEUDOCODE
'===========
'EinfügeZielRange ermitteln (1.=A5, 2.=D5, 3.=G5, ...?)
'File öffnen (Workbooks.OpenText Filename:=varfilenames(lngCount), Origin:= ...)
'Range kopieren
'in ZielRange einfügen
'CutCopyMode=false
'geöffnetes File Schliessen
Next lngCount 'nächstes File der Auswahl
End Sub

Evtl. kannst Du damit weiterarbeiten. So Du damit nicht ans Ziel kommst, kannst Du Deine beiden BeispielDateien ja mal zur Ansicht ins Netz stellen. (z.B. hier (Downloadlink dann hier posten)).

bye
malSchauen

Answer 2

hi,

danke dir schonmal! ich habe die beiden dateien mal hochgeladen...

http://www.file-upload.net/download-2435983/1.prf.html
http://www.file-upload.net/download-2435984/2.prf.html

wenn sie mit excel geöffnet werden sollen, beginnend in zeile 6 und trennzeichen sind tabstopp und komma.
vielleicht könntest du mir den code zum weiterverarbeiten noch in dein makro einfügen, dann wäre mir sehr geholfen!

vielen dank und freundliche grüße
harry

Answer 3

Hi,

Die Vervollständigung des Codes hatte ich mir in etwa vorgestellt, wie folgt:

Sub naLos()
Dim varFileNames As Variant
Dim lngCount As Long
Dim wksZiel As Worksheet
Dim wbkQuelle As Workbook
Dim lngZielSpalte As Long

varFileNames = Application _
.GetOpenFilename("PICS-Regeldateien (*.prf), *.prf", 1, "Datei wählen", , True) 'Filenamen holen
If VarType(varFileNames) = vbBoolean Then 'bei Abbruch
MsgBox "Keine Datei gewählt!" 'kleine Meldung
Exit Sub 'Makro Ende
End If

Application.ScreenUpdating = False 'Bildschirmaktualisierung aus

Set wksZiel = ThisWorkbook.Worksheets("Tabelle1") 'ZielTabelle !anpassen! und "merken"
'ggf. hier gesamten Zielbereich löschen
With wksZiel
.Range(.Range("A5"), .Range("A5").SpecialCells(xlCellTypeLastCell)).ClearContents
End With

For lngCount = LBound(varFileNames) To UBound(varFileNames) Step 1 'vom ersten bis zum letzten File
' MsgBox ("File " & varFileNames(lngCount) & " wird verarbeitet") 'Meldung hier nur als Beispielcode
'===========
'PSEUDOCODE
'===========
'EinfügeZielRange ermitteln (1.=A5, 2.=D5, 3.=G5, ...?)
lngZielSpalte = lngCount + (lngCount - 1) * 2
'File öffnen (Workbooks.OpenText Filename:=varfilenames(lngCount), Origin:= ...)
Workbooks.OpenText Filename:=varFileNames(lngCount), StartRow:=6, Tab:=True, Comma:=True
Set wbkQuelle = ActiveWorkbook
'Range kopieren
wbkQuelle.ActiveSheet.Range("A1").CurrentRegion.Copy
'in ZielRange einfügen
wksZiel.Cells(5, lngZielSpalte).Value = wbkQuelle.Name
wksZiel.Cells(6, lngZielSpalte).PasteSpecial Paste:=xlAll
Application.CutCopyMode = False
'geöffnetes File Schliessen
wbkQuelle.Close
Next lngCount 'nächstes File der Auswahl

Application.ScreenUpdating = True 'Bildschirmaktualisierung ein
wksZiel.Range("A5").Select

Set wksZiel = Nothing
Set wbkQuelle = Nothing
End Sub

bye
malSchauen

Answer 4

hi,

danke schonmal. jedoch bekomme ich eine fehlermeldung "laufzeitfehler 1004:die select mehtode des range objekts kann nicht ausgeführt werden"
nach debuggen: => wksZiel.Range("A5").Select

gruß harry

Answer 5

Hi,

Ändere das Ende des Subs einmal wie folgt:

.
.
.
Application.ScreenUpdating = True 'Bildschirmaktualisierung ein
ThisWorkbook.Activate
wksZiel.Select
wksZiel.Range("A5").Select

Set wksZiel = Nothing
Set wbkQuelle = Nothing
End Sub

Dann solte dieser Fehler eigtl. nicht mehr auftreten können.

bye
malSchauen

Answer 6

sieht sehr gut aus!

vielen dank!

Answer 7

hi,

jetzt stellt sich mir doch noch eine frage:

durch das makro werden zelleninhalte in den spalten c, f, i, etc gelöscht.
wie kann ich das verändern? in diesen spalten darf nichts gelöscht werden...es sollen wirklich nur jeweils 2spalten eingefügt werden aus den geldenen dateien.

gruß harry

Answer 8

fehler gefunden^^