Office: (Office 2010) VBA

mücke · 4. August 2014

Moin,

ich bräuchte mal bitte Eure Hilfe.

Folgende Situation:
Ich möchte aus einer Excel-Datei eine andere .xls Datei öffnen.
Dazu nutze ich folgende CODE *Smilie
Code:

Option Explicit

Sub Dateioeffen()

Dim periode As String, Meldung As String
Dim varDatei As Variant

Const pfad As String = "D:\Projekte\Buchungsbelege\2014\"

ChDrive "D:"
ChDir pfad

varDatei = Application.GetOpenFilename("Excel-Arbeitsmappen,*.xls,", 1, _
"Bitte wählen Sie eine Datei aus!")

If varDatei = False Then
MsgBox "Durch Benutzer abgebrochen.", vbInformation
Exit Sub
Else
Workbooks.Open varDatei
Meldung = "Bitte tragen Sie die zu speichernde Periode ein: Eingabe: jjjj.mm"
periode = InputBox(Meldung)
End If

ActiveWorkbook.SaveAs Filename:=pfad & "Basisdaten\" & ActiveSheet.Name & "_" & periode & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWorkbook.Close

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Das Verzeichnis umfasst ca. 150 Excel-Dateien und mehrere Word, PowerPoint und .pdf Dateinen mit unterschiedlichen Bezeichnungen.

Meine Frage ...
mit Code:

Application.GetOpenFilename("Excel-Arbeitsmappen,*.xls,"
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

werden mir nur die .xls Dateine angezeigt.

Kann ich hier noch eine weitere Filterung einbauen?
So nach dem Motto: ... zeige mir alle .xls Dateien die mit ZP und ZS anfangen.

Geht so etwas?

Schon mal Danke für Deine Zeit, Gruß Dirk

:)

EarlFred · 6. August 2014

Hallo Dirk,

ich nehme lieber die FileDialogs:
Code:

Option Explicit

Sub Dateioeffnen()

Dim periode As String, Meldung As String
Dim strDatei As String
Dim wbToOpen As Workbook

Const pfad As String = "D:\Projekte\Buchungsbelege\2014\"

With Application.FileDialog(msoFileDialogOpen)
.InitialFileName = pfad & "Z*.xls"
If .Show Then
strDatei = .SelectedItems(1)
Set wbToOpen = Workbooks.Open(strDatei)
Meldung = "Bitte tragen Sie die zu speichernde Periode ein: Eingabe: jjjj.mm"
periode = InputBox(Meldung)

Else
MsgBox "Durch Benutzer abgebrochen.", vbInformation
Exit Sub
End If
End With

wbToOpen.SaveAs Filename:=pfad & "Basisdaten\" & ActiveSheet.Name & "_" & periode & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
wbToOpen.Close

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

ZS* oder ZP* gleichzeitig kann der aber m. W. auch nicht - dann müsste was selbst geschriebenes her.

Grüße
EarlFred

mücke · 6. August 2014

Moin EarlFred,

... Danke *Smilie

Die Varinate FileDialogs: kannte ich "noch" nicht, das Ergebnis sieht aber auch sehr gut aus *Smilie

ZS* oder ZP* gleichzeitig kann der aber m. W. auch nicht - dann müsste was selbst geschriebenes her
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

.
So etwas habe ich mir schon fast gedacht, da Tante Google auch nichts ausgespuckt hat.

Wäre der Aufwand für "etwas selbst geschriebenes" sehr groß?
Die Filterung würde sich auf max. 5 verschiedene Kennungen beziehen.

Danke, Gruß Dirk

mücke · 6. August 2014

Moin EarlFred,

da habe ich mich doch von den Kennungen etwas irritieren lassen *redface
ZS, ZP usw. fangen ja alle mit Z an und somit ist das Problem gelöst *biggrin.gif*

Vielen Dank und eine ruhige Restwoche wünscht Dirk

EarlFred · 6. August 2014

Hallo Dirk,

und somit ist das Problem gelöst
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Wie bitte??? Probleme einfach selbst lösen??? Wo kämen wir denn da hin?!?! Du weißt wohl nicht, wofür ein Forum da ist???!!!?? *wink.gif*

ZS, ZP usw. fangen ja alle mit Z an...
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Und soooo leicht kommste mir nicht davon: Was ist mit Dateien mit Namen "ZU" "ZA" "ZY"? Hmmm??? *wink.gif*

Jetzt schauste Dir wenigstens den Code mal an, den ich grad extra für Dich geklimpert habe:
Code:

Option Explicit
Option Compare Text

Private Sub UserForm_Initialize()

On Error GoTo ErrExit

Dim dicAusgabe As Object
Dim shShell As Object
Dim shFolder As Object
Dim vFilter As Variant
Dim blnSubfolders As Boolean

Set dicAusgabe = CreateObject("Scripting.Dictionary")
Const cStrPfad As String = "D:\Projekte\Buchungsbelege\2014\"

Set shShell = CreateObject("Shell.Application")
Set shFolder = shShell.Namespace(cStrPfad)

If Not shFolder Is Nothing Then
vFilter = Array("ZS*.xls", "ZP*.xls")
blnSubfolders = MsgBox("Unterordner duchsuchen?", vbYesNo, "Abfrage") = vbYes

listFiles shFolder, blnSubfolders, vFilter, dicAusgabe
Else
MsgBox "Der Ordner " & cStrPfad & " wurde nicht gefunden!"
End If

Me.ComboBox1.List = dicAusgabe.Keys '"dicAusgabe.Items" für reine Dateinamen verwenden!

ErrExit:
If Err Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description & vbLf & "Anzahl gefundene Dateien: " & dicAusgabe.Count
Set shFolder = Nothing
Set shShell = Nothing
Set dicAusgabe = Nothing
End Sub
Private Sub listFiles(ByRef shFolder As Object, ByRef blnRecurr As Boolean, ByRef vFilter As Variant, ByRef dicAusgabe As Object)

Dim shFItemp As Object
Dim i As Long

On Error Resume Next

For Each shFItemp In shFolder.Items
If shFItemp.IsFolder And blnRecurr = True And LCase$(Right$(shFItemp.Name, 4)) ".zip" Then
listFiles shFItemp.GetFolder, True, vFilter, dicAusgabe
ElseIf (Not shFItemp.IsFolder Or LCase$(Right$(shFItemp.Name, 4)) = ".zip") Then
For i = LBound(vFilter, 1) To UBound(vFilter, 1)
If (shFItemp.Name Like vFilter(i)) Then
dicAusgabe(shFItemp.Path & "\" & shFItemp.Name) = shFItemp.Name
End If
Next i
End If
Next shFItemp
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Du brauchst eine Userform mit einer Combobox (oder Listbox, was Dir lieber ist).
Neben Dateinamen oder Pfad kannst Du auch noch zig andere Sachen einblenden, wenn Du wollen wölltetest.

Grüße
EarlFred

mücke · 6. August 2014

Moin EarlFred,

wie konnte ich nur *biggrin.gif* ... wird nicht wieder vorkommen *tongue.gif*

... nur leider bekomme ich keine Daten angezeigt *frown.gif*

Was habe ich gemacht ...
_ eine UserForm angelegt und den CODE dort hinterlegt.
_ ein Kombinationsfeld auf die Oberfläche der UserForm gelegt.

Wenn ich den CODE mit F8 durchlaufe, gibt es keine Fehlermeldungen, es kommt nur die Abfrage bzgl. Unterordnet -> mit JA bestätigt und dann läuft er bei For Each shFItemp In shFolder.Items weiter.
Am Ende bekomme ich eine leere ComboBox angezeigt, was mache ich falsch?

Gruß Dirk

EarlFred · 7. August 2014

Hallo Dirk,

dann hast Du vermutlich keine Datei im Pfad, die dem Filter "ZS*.xls" oder "ZP*.xls" entspricht. Sind das vielleicht Dateien in Formaten ab Excel 2007, also keine "xls"?

Probier mal:
Code:

vFilter = Array("*.xls*")
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Zu Beginn wird in der Combobox auch nichts angezeigt, dafür musst Du sie aufklappen. Oder Du nimmst eine Listbox.

Grüße
EarlFred

mücke · 7. August 2014

Moin EarlFred,

da stehe ich jetzt aber echt auf´m Schlauch *rolleyes.gif*
Die Dateien kommen aus SAP und haben laut Eigenschaften den Dateityp Microsoft Excel 97-2003-Arbeitsblatt (.xls)

Auch wenn ich die Filterung in vFilter = Array("*.xls*") ändere, bleibt alles leer.
Habe es jetzt mal mit einer Combobox und einer Listbox versucht, gleiches Ergebnis.

Was mache ich nur falsch??

Gruß Dirk

EarlFred · 7. August 2014

Hallo Dirk,

keine Ahnung!
Dass der von Dir angegebene Pfad "D:\Projekte\Buchungsbelege\2014\" stimmt, setze ich mal voraus.

Grüße
EarlFred

mücke · 7. August 2014

Moin EarlFred,

den Pfad habe ich geprüft und auch schon mal nur auf D:\ gekürzt, gleiches Ergebnis.

Werde die Datei mal zur Seite legen und am WE weiter machen.
Bei Fehlern die ich nicht nachvollziehen kann, könnte ich platzen *mad.gif*

Melde mich dann wieder, vielen Dank und bis bald, Gruß Dirk

mücke · 7. August 2014

Moin,

habe noch mal ein wenig getestet und bin zu folgendem Ergebnis gekommen:

Wenn ich den Filter mit .xls vFilter = Array("ZS*.xls", "ZP*.xls") verwende, bleibt die Suche ohne Erfolgt,
wenn ich den Filter ohne .xls vFilter = Array("ZS*", "ZP*") verwende, bekomme ich die Dateien in der Box angezeigt.

Habe es auch schon mal mit anderen Dateien (.pdf, .mp3) probiert, gleiches Ergebnis *frown.gif*

Warum dies so ist, kann ich nicht begründen, ich finden die Ursache für dieses Phänomen einfach nicht.

Ich werde jetzt die Variante aus #2 nehmen.

Wünsche allen ein *Sun Wochenende, Gruß Dirk

EarlFred · 7. August 2014

Hallo Dirk,

hast Du die Zeile
Code:

Option Compare Text
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

im Code gelassen?

Das wäre noch mein letzter Ansatz, dann passe ich.

Grüße
EarlFred

mücke · 13. August 2014

Moin EarlFred,

sorry für die späte Rückmeldung.

Auch der Hinweis aus #12 bringt mich leider nicht weiter.

Schöne Restwoche ... Danke, Gruß Dirk

Office: (Office 2010) VBA

VBA

VBA

VBA

VBA

VBA

VBA - Similar Threads - VBA

VBA in einer Zeile zu lang

Listbox wird nicht breiter, Schriftgrösse ändert sich

Kontrollkästchen aktivieren ohne VBA - wenn KK1 angekreuzt dann KK2 auch

Per Hyperlink ausgeblendetes Blatt einblenden

Bilder über VBA Größe und DPI ändern für Webshop

VBA: Platzhalter ersetzen und evtl. leere Zeile einfügen

Erstellung eines Dynamischen Kalenders (ggf. VBA)