Top-Themen

Aktuelle Themen (A bis Z)

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit

gelöst Gibt es Ersatz für Application.FileSearch in Access 2007

Mitglied: RicoTumb

RicoTumb (Level 1) - Jetzt verbinden

15.03.2010, aktualisiert 18:21 Uhr, 7315 Aufrufe, 6 Kommentare

Application.FileSearch funktioniert in Access 2007 nicht mehr.

Hallo zusammen,

ich habe hier einen VBA Code vorliegen, der unter Office 2003 wunderbar funktioniert hat, jedoch unter Office 2007 nicht mehr funktioniert, weil einige Befehle in 2007 nicht mehr übernommen worden sind. Mein Problem liegt bei Application.FileSearch. Das gibt es leider in 2007 nicht mehr. Ich habe schon einmal gelesen, dass man es mit Dir() oder ObjectFileSearch ersetzen könnte, jedoch habe ich keine Ahnung, wie ich dies auf meinen Vorliegenden Code anwenden soll. Ich poste auch gleich den Code (der ein wenig lang ist). Wichtig ist jedoch nur der Teil, wo fs vorkommt, da fs folgendermaßen deklariert worden ist:

Set fs = Application.FileSearch´

Wäre super wenn jemand einmal drüberschauen und mir eine Lösung vorschlagen könnte. Was ich auch versucht habe, es hat nicht viel gebracht.

Beste Grüße,
Rico


01.
Private Sub Butt_OK_Click()
02.
Dim FileName As String
03.
Dim lPlanung As String
04.
Dim dPlanung As String
05.
Dim lPlanName As String
06.
Dim lPlanungslösung As String
07.
Dim ldatetime As Date
08.
Dim lRec As Integer
09.
Dim lRecCount As Integer
10.

11.
Set fs = Application.FileSearch
12.

13.

14.
dPlannung = "Planungssheets\"
15.

16.
lPlanName = Get_Planung_Aktuell("Planung")
17.
lPlannung = "Plannung_" + lPlanName + "_"
18.
ldatetime = Date + Time
19.

20.
If LB_Planer.ItemsSelected.Count > 0 Then
21.

22.

23.
    If MsgBox("Planungsfiles für " & LB_Planer.ItemsSelected.Count & " markierte Planungslösungen importieren?", vbYesNo) = vbYes Then
24.
        
25.
        DoCmd.Hourglass (True)
26.
        T1.Caption = " Planungssheets werden importiert. Bitte warten!!!"
27.
        T1.Visible = True
28.
        Me.Repaint
29.
        lRecCount = LB_Planer.ItemsSelected.Count * 7
30.
        lRec = 0
31.
        For Each varItm In LB_Planer.ItemsSelected
32.
            
33.
            go_on = True
34.
            'Sucht und importiert Planungstemplate
35.
            delete_ignore = True
36.
            'löscht Termine falls erneut importiert
37.
            'Schalter für Schweiz und Austria bei getrenntem import auf true setzen
38.
            If delete_ignore = False Then
39.
                If Len(LB_Planer.Column(4, varItm)) > 0 Then
40.
                    'Wenn schon importiert dann Suche nach Events mit bereits geplanten Räumen
41.
                    lIs_Raum = Proof_Raumvergeben(lPlanName, LB_Planer.Column(1, varItm))
42.
                    If lIs_Raum Then
43.
                        MsgBox ("Planung für Lösung " + LB_Planer.Column(1, varItm) + " wurde bereits importiert und Räume wurden bereits zugewiesen. Planung kann nicht überschrieben werden!!!")
44.
                        go_on = False
45.
                    Else
46.
                        If MsgBox("Planung für Lösung " & LB_Planer.Column(1, varItm) & " wurde bereits importiert!" & Chr(13) & Chr(13) & "Überschreiben?", vbYesNo) = vbYes Then
47.
                            
48.
                            lsql = "DELETE KursePlanungChanges.*, KursePlanung.Planung"
49.
                            lsql = lsql + " FROM KursePlanung RIGHT JOIN KursePlanungChanges ON KursePlanung.ID = KursePlanungChanges.ID"
50.
                            lsql = lsql + " WHERE [Planung]='" + Get_Planung_Aktuell("PLanung") + "'"
51.
                            lstr = lstr + " AND [Planungslösung]='" + LB_Planer.Column(1, varItm) + "'"
52.
                            DoCmd.RunSQL (lsql)
53.
                            
54.
                            lstr = "DELETE * FROM KursePlanung "
55.
                            lstr = lstr + " WHERE [Planung]='" + lPlanName + "'"
56.
                            lstr = lstr + " AND [Planungslösung]='" + LB_Planer.Column(1, varItm) + "'"
57.
                            DoCmd.RunSQL (lstr)
58.
                        Else
59.
                            go_on = False
60.
                            
61.
                        End If
62.
                    End If
63.
                End If
64.
            End If
65.
            If Not go_on Then
66.
                lRec = lRec + 7
67.
            Else
68.
                
69.
With fs
70.
                    .LookIn = GetAppPath(True) + dPlannung
71.
                    .FileName = lPlannung + LB_Planer.Column(1, varItm) + ".xls"
72.
                    If .Execute = 0 Then
73.
                        DoCmd.Hourglass False
74.
                        MsgBox ("Planungsfile " & fs.LookIn & "\" & fs.FileName & "  nicht gefunden!" + Chr(13) + "Planung für Lösung " + LB_Planer.Column(1, varItm) + " kann nicht importiert werden!")
75.
                        DoCmd.Hourglass (True)
76.
                    Else
77.
                        'Datei in eine Temporäre EXCEL Kopieren
78.
                        Set fso = CreateObject("Scripting.FileSystemObject")
79.
                        Set f = fso.GetFile(fs.LookIn & "\" & fs.FileName)
80.
                        zieldatei = GetAppPath(True) + "Plannungtemp.xls"
81.
                        S = f.copy(zieldatei)
82.
                        lRec = Schreibe_Zeiger(lRec, lRecCount)
83.
                        
84.
                        'Arbeitsblatt der Temporärendatei anpassen
85.
                        Set oApp = CreateObject("excel.application")
86.
                        oApp.Visible = False
87.
                        oApp.Workbooks.Open FileName:=zieldatei
88.
                        lPlanName = oApp.Sheets("Einleitung").Cells(1, 2).Value
89.
                        lPlaner = oApp.Sheets("Einleitung").Cells(4, 2).Value
90.
                        lPlanungslösung = oApp.Sheets("Einleitung").Cells(3, 2).Value
91.
                        oApp.Sheets("Termine").UnProtect Password:="lgd"
92.
                        oApp.Sheets("Termine").RowS("1:1").Select
93.
                        oApp.Sheets("Termine").RowS("1:1").Delete Shift:=xlUp
94.
                        oApp.ActiveWorkbook.Close SaveChanges:=True
95.
                        oApp.Quit
96.
                        lRec = Schreibe_Zeiger(lRec, lRecCount)
97.
                        
98.
                        
99.
                        'Daten in Temporäre Accesstabelle lesen
100.
                        lDatei = "TEMPPlanung"
101.
                        DoCmd.DeleteObject acTable, lDatei
102.
                        DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
103.
                            lDatei, zieldatei, True, "Termine!A1:J2000"
104.
                        lRec = Schreibe_Zeiger(lRec, lRecCount)
105.
                            
106.
                            
107.
                        'Schreibt alle Kurse in Kursdatei
108.
                        lstr = "INSERT INTO KursePlanung ( [Kurs-Nr], Coll, S, Beginn, Ende, Ort, [Ort fix], Referent, Anmerkungen )"
109.
                        lstr = lstr + "SELECT TEMPPlanung.[Kurs-Nr], TEMPPlanung.Coll, TEMPPlanung.S, TEMPPlanung.Beginn, TEMPPlanung.Ende, TEMPPlanung.Ort, TEMPPlanung.[Ort fix], TEMPPlanung.Referent, TEMPPlanung.Anmerkungen FROM TEMPPlanung"
110.
                        lstr = lstr + " WHERE [Kurs-Nr] <> ''"
111.
                        DoCmd.RunSQL (lstr)
112.
                        lRec = Schreibe_Zeiger(lRec, lRecCount)
113.
                        
114.
                        'Schreibt Planung, Planer und Lösung in Kursdatei
115.
                        lstr = "UPDATE KursePlanung SET"
116.
                        lstr = lstr + " KursePlanung.Planung = '" + lPlanName + "'"
117.
                        lstr = lstr + ", KursePlanung.Planer = '" + lPlaner + "'"
118.
                        lstr = lstr + ", KursePlanung.Planungslösung = '" + lPlanungslösung + "'"
119.
                        lstr = lstr + " WHERE (((KursePlanung.Planung) = '' Or (KursePlanung.Planung) Is Null))"
120.
                        DoCmd.RunSQL (lstr)
121.
                        lRec = Schreibe_Zeiger(lRec, lRecCount)
122.
                        
123.
                        'Erstellt Referenteneinträge
124.
                        Call Erstelle_Referenten(lPlanName, lPlanungslösung)
125.
                        
126.
                        
127.
                        'Setze Import Zeitstempel
128.
                        Call Schreibe_Import_Loesung(lPlanName, LB_Planer.Column(0, varItm), ldatetime)
129.
                    End If
130.
                
131.
                End With
132.
            End If
133.
            lRec = Schreibe_Zeiger(lRec, lRecCount)
134.
        Next varItm
135.

136.
        LB_Planer.Requery
137.
        T1.Caption = "Import erfolgreich durchgeführt!"
138.
        DoCmd.Hourglass (False)
139.
    
140.
    End If
141.
Else
142.
    MsgBox ("Keine Planungslösung/Planungsverantwortlichen markiert!!!")
143.

144.
End If
145.

146.

147.
End Sub
[Edit Biber] Codetags++ [/Biber]
Mitglied: Biber
15.03.2010 um 20:30 Uhr
Moin RicoTumb,

Was ich auch versucht habe, es hat nicht viel gebracht.
Was war das denn?
Ich meine, du nutzt die das FileSearch-Object ja nun nicht gerade exzessiv, wenn ich nicht mit den Augen habe.

In Zeile 70 bastelst du dir für das fs-Objekt einen Pfad-String zusammen
.LookIn = GetAppPath(True) + dPlannung
---> den kannst du auch direkt in eine Stringvariable schreiben
In Zeile 71 brätst du dir ebenfalls für das fs-Objekt wiederum einen String zusammen....
.FileName = lPlannung + LB_Planer.Column(1, varItm) + ".xls"
---> den kannst du ebensogut in eine zweite Stringvariable schreiben 8die kosten ja heutzutage kaum noch was)
Statt des "If .Execute = 0 Then" kannst du ebensogut die banale Existenz der gesuchten Datei (= string1 & "\" & string2) prüfen

... und die anderen fs.method-Aufrufe sind doch alle durch die beiden string1/string2-Klamotten ersetzbar.

Wo genau siehst du das Problem? Nostalgie?
Das FileSearch-Gelumpe ist doch als rekursiv aufgemotztes Kompakt-FileSystemObject schon immer nur sinnvoll gewesen in Verzeichnis-Zweigarmen.
Und eher überdimensioniert in "flachen" Strukturen/einzelnen Pfaden.
Also brauchst du das doch eh nicht und hast es noch nie gebraucht.

Grüße
Biber
Bitte warten ..
Mitglied: RicoTumb
22.03.2010 um 10:29 Uhr
Hallo Biber,

vielen herzlichen Dank! War wohl wirklich um einiges einfacher als ich dachte. Application.FileSearch benötige ich hier wirklich nicht...

Beste Grüße,
Rico
Bitte warten ..
Mitglied: RicoTumb
22.03.2010 um 16:49 Uhr
Hallo Biber,

das Problem mit dem obigen Code ist gelöst...Nochmals danke! Jetzt habe ich ein sehr ähnliches Problem und weiß nicht weiter. Bei folgendem Code hätte ich Application.FileSearch genauso ersetzt, wie du mir empfohlen hast. Dies funktioniert diesmal leider nicht, da sonst die For-Schleife nicht funktioniert. Ich denke es hängt mit dem .Execute zusammen. Der Fehler taucht bei .FoundFiles.Count auf, wenn ich die Pfade als String festlege. Könntest Du mir bitte hierzu nochmals eine Empfehlung geben?

Sub Change_Auswertung_Database()
Dim lPfad As String
Dim lDatei As String

Set fs = Application.FileSearch

dAuswertung = "Auswertungen\"
lPfad = GetAppPath(False)
lDatei = "\" + GetAppName() + ".mdb"

With fs
.LookIn = GetAppPath(True) + dAuswertung
.FileName = "*.xls"
.Execute

For i = 1 To .FoundFiles.Count
zieldatei = .FoundFiles(i)
Set oApp = CreateObject("excel.application")
oApp.Visible = True
oApp.Workbooks.Open FileName:=zieldatei
oApp.Run "Change_Pivot_Database", lPfad, lDatei
oApp.ActiveWorkbook.Close SaveChanges:=True
oApp.Quit
Next i
End With

End Sub


Vielen herzlichen Dank!!
Rico
Bitte warten ..
Mitglied: Biber
22.03.2010 um 20:16 Uhr
Moin Rico,

Ich bin momentan auch etwas knapp mit (Forums-) Zeit.

Die Lösung geht jedenfalls in die Richtung: Ersetze das Application.Filesearch-Object durch ein "einfaches" FileSystemObject.
Und einige hundert oder tausend andere Access 2007-Umsteiger hatten/haben das gleiche Problem, eben weil es dieses FileSearch-Object nicht mehr gibt.
Kannst ja schon mal über eine Suchmaschine vortesten -- das Netz ist voll davon.

Andernfalls - etwas Geduld bitte.
Grüße
Biber
Bitte warten ..
Mitglied: bastla
22.03.2010 um 21:33 Uhr
Hallo RicoTumb!

Du könntest es zwischenzeitlich mit diesem (allerdings völlig ungetesteten und nur für eine Ordnerebene ausgelegten) Ansatz versuchen:
01.
Sub Change_Auswertung_Database()
02.

03.
dAuswertung = "Auswertungen\"
04.
lPfad = GetAppPath(False)
05.
lDatei = "\" + GetAppName() + ".mdb"
06.

07.
Set fso = CreateObject("Scripting.FileSystemObject")
08.
For Each zieldatei In fso.GetFolder(GetAppPath(True) & dAuswertung).Files
09.
    If LCase(fso.GetExtensionName(zieldatei.Name)) = "xls" Then
10.
        Set oApp = CreateObject("excel.application")
11.
        oApp.Visible = True
12.
        oApp.Workbooks.Open FileName:=zieldatei
13.
        oApp.Run "Change_Pivot_Database", lPfad, lDatei
14.
        oApp.ActiveWorkbook.Close SaveChanges:=True
15.
        oApp.Quit
16.
    End If
17.
Next
18.
End Sub
Grüße
bastla
Bitte warten ..
Mitglied: RicoTumb
01.04.2010 um 16:26 Uhr
Hallo bastla,

herzlichen Dank!!! Funktioniert wunderbar =)

Grüße,
Rico
Bitte warten ..
Ähnliche Inhalte
Microsoft Office
Access 2007
gelöst Frage von EverestMicrosoft Office2 Kommentare

Hallo Access-Spezialist, kann mir jemand helfen mit der Access Datenbank, die ich selbst zusammen gebastelt habe. Ich habe zwei ...

Monitoring
VNC Ersatz!?
gelöst Frage von Hendrik2586Monitoring25 Kommentare

Hello und Guten Morgen an alle. :) Hat jemand von euch eine Idee zwecks einem kostenfreien bzw. kostengünstigen Ersatz ...

LAN, WAN, Wireless
Ersatz für FritzFernzugang?
gelöst Frage von McLionLAN, WAN, Wireless14 Kommentare

Hallo, ich habe bis jetzt für meine VPN-Verbindung das Prog FritzFernzugang verwendet. Kennt jemand eine Alternative dafür? Danke!

Microsoft Office

Excel 2007 - Datenbank aus Access inportieren

gelöst Frage von JoSiBaMicrosoft Office5 Kommentare

Hallo, ich möchte das Excel 2007 meine Datenbank aus Access 2007 importiert und die Datenbank sofort wieder frei gibt. ...

Neue Wissensbeiträge
Router & Routing
Der "768k-Day" kommt
Information von LordGurke vor 7 StundenRouter & Routing2 Kommentare

Für Leute, die Router mit BGP-Fulltable betreiben vielleicht ein interessanter Hinweis: Die IPv4-Fulltable erreicht voraussichtlich innerhalb der nächsten 2-3 ...

Debian

Partition angeblich voll, dabei aber noch nicht mal zur Hälfte belegt

Anleitung von diemilz vor 10 StundenDebian7 Kommentare

Hallo zusammen, ich habe ein kleines Problem: Ich habe auf einem physischen Debian Linux Server als ZoneMinder-Server (HP ProLiant ...

Windows 7
Updategängelung auf Windows 10, die zweite
Information von Penny.Cilin vor 5 TagenWindows 72 Kommentare

Hallo, da Windows 7 im kommenden Jahr nicht mehr supportet wird, werden Nutzer von Window 7 home premium wieder ...

Internet
EU-Urheberrechtsreform: Zusammenfassung
Information von Frank vor 7 TagenInternet1 Kommentar

Auf golem.de gibt es eine Analyse von Friedhelm Greis, der das Thema EU-Urheberrechtsreform gut und strukturiert zusammenfasst. Zwar haben ...

Heiß diskutierte Inhalte
Backup
Veeam Community Edition
gelöst Frage von dgrebnerBackup21 Kommentare

Hallo Zusammen, kann jemand seine praktischen Erfahrungswerte mit der Veeam-Community Edition mit mir teilen? Es gab dazu ja schon ...

LAN, WAN, Wireless
Notebooks in Firmenwlan authentifizieren
gelöst Frage von EarthShakerLAN, WAN, Wireless17 Kommentare

Guten Tag, unsere Firma möchte gerne flächendeckend WLAN einführen und hat zu diesem Zweck einen Dienstleister beauftragt. Wir benötigen ...

Festplatten, SSD, Raid
Harddisk kaputt, was sagt mir ChrystalDiskInfo
gelöst Frage von InfoSeekerFestplatten, SSD, Raid14 Kommentare

Hallo zusammen, Mein Rechner lahmt. Ich stell mir die Frage woran es liegt und bin der Meinung es ist ...

Netzwerkmanagement
Netzwerk vorübergehend weg
gelöst Frage von ahstaxNetzwerkmanagement13 Kommentare

Hallo, folgendes Szenario stellt sich dar: Im Netzwerk mit Win7-PCs wurden Switche ausgetauscht. Grundsätzlich funktioniert alles mindestens so gut ...