Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

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

Frage Entwicklung VB for Applications

Mitglied: RicoTumb

RicoTumb (Level 1) - Jetzt verbinden

15.03.2010, aktualisiert 18:21 Uhr, 6580 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 ..
Neuester Wissensbeitrag
Humor (lol)

Linkliste für Adventskalender

(3)

Information von nikoatit zum Thema Humor (lol) ...

Ähnliche Inhalte
Microsoft Office
gelöst Access 2007 (2)

Frage von Everest zum Thema Microsoft Office ...

Datenbanken
gelöst Gibt es in Access eine Möglichkeit die Anzahl der Arbeitstage auszugeben (5)

Frage von Dr.Cornwallis zum Thema Datenbanken ...

LAN, WAN, Wireless
Freifunk über vorhandene Access Points ausstrahlen (2)

Frage von Uwoerl zum Thema LAN, WAN, Wireless ...

Windows Netzwerk
Direct Access mit VPN aufbau (4)

Frage von geocast zum Thema Windows Netzwerk ...

Heiß diskutierte Inhalte
Windows Server
DHCP Server switchen (22)

Frage von M.Marz zum Thema Windows Server ...

Hardware
gelöst Negative Erfahrungen LAN-Karten (19)

Frage von MegaGiga zum Thema Hardware ...

SAN, NAS, DAS
gelöst HP-Proliant Microserver Betriebssystem (14)

Frage von Yannosch zum Thema SAN, NAS, DAS ...

Grafikkarten & Monitore
Win 10 Grafikkarte Crash von Software? (13)

Frage von Marabunta zum Thema Grafikkarten & Monitore ...