Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
756to760
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
756to760
756to760
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Datei suchen

Datei suchen
22.04.2006 19:03:17
Norman
Hallo alle zusammen,
ich hoffe, Ihr könnt mir weiterhelfen:
Ich lese bestimmte Zellwerte einer Datei "Tabelle1.xls" aus und importiere diese in eine andere Datei "Tabelle2.xls".

Private Function GetValue(path, file, sheet, ref)
Dim arg As String
If Right(path, 1) <> "\" Then path = path & "\"
If Dir(path & file) = "" Then
GetValue = "File Not Found"
Exit Function
End If
arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
Range(ref).Range("A1").Address(, , xlR1C1)
GetValue = ExecuteExcel4Macro(arg)
End Function

Sub Daten_Einlesen()
Dim p As String
Dim f As String
Dim s As String
p = "F:\Tabellen\"
f = "Tabelle1.xls"
s = "RefDat"
Dim l As Integer
For l = 15 To 75
Wert = GetValue(p, f, s, "DX" & l)
Sheets("RefDat").Cells(l, 128).Value = Wert
Wert = GetValue(p, f, s, "DY" & l)
Sheets("RefDat").Cells(l, 129).Value = Wert
Next
End Sub
Soweit läuft das Makro perfekt. Nun meine bitte. Es kann sein, dass sich die Quelldatei nicht immer in dem selben Verzeichnis befindet. Der Name der Datei und das Laufwerk sind jedoch konstant. Wie kann ich das Makro so umschreiben, dass die Datei an jedem beliebigen Ort auf Laufwerk F:\ sein kann und dennoch ausgelesen wird?
Vielen Dank schon mal im Voraus für Eure Hilfe.
Norman

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Datei suchen
22.04.2006 19:55:54
Gerd
Hi,
bei VBA gut sollte der Hinweis auf Filesearch reichen.
mfg Gerd
AW: Datei suchen
22.04.2006 20:15:29
Norman
Hallo Gerd,
ich hatte eine Prozedure mit filesearch schon ausprobiert. Es aber leider nicht zum Laufen gebracht. Über eine ausführlichere Hilfe wäre ich Dir sehr dankbar.
Vielen Dank nochmal,
Norman
AW: Datei suchen
22.04.2006 20:20:26
Gerd
"ich hatte eine Prozedure mit filesearch schon ausprobiert."
Dann poste doch mal den Versuch.
mfg Gerd
AW: Datei suchen
22.04.2006 20:41:17
Norman

Private Function GetValue(path, file, sheet, ref)
Dim arg As String
arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
Range(ref).Range("A1").Address(, , xlR1C1)
GetValue = ExecuteExcel4Macro(arg)
End Function

Sub Daten_Einlesen()
Dim p As String
Dim f As String
Dim s As String
With Application.FileSearch
.LookIn = "F:\"
.SearchSubFolders = True
.Filename = "Tabelle1.xls"
If .Execute > 0 Then
...mein VBA-Latein am Ende
End If
End With
' p = "F:\" -> sollen durch das Suchergebnis ersetzt werden
' f = "Tabelle1.xls" -> sollen durch das Suchergebnis ersetzt werden
s = "RefDat"
Dim l As Integer
For l = 15 To 75
Wert = GetValue(p, f, s, "DX" & l)
Sheets("RefDat").Cells(l, 128).Value = Wert
Wert = GetValue(p, f, s, "DY" & l)
Sheets("RefDat").Cells(l, 129).Value = Wert
Next
End Sub
Bitte gib mir eine Lösung oder einen Ansatz. Ich habe leider keinen Anhaltspunkt weiter. Ich nehme meine "VBA Gut" Kenntnisse zurück, wenn das schon dazu gehört.
Anzeige
AW: Datei suchen
22.04.2006 21:21:11
Tassos
Hallo Gerd,
Probier`s so:

Sub RvrsFiles() 'In deinem Code kopieren
Dim i&, wb As Workbook
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
On Error Resume Next
With Application.FileSearch
.NewSearch
.LookIn = "C:\Tabellen"
.SearchSubFolders = True
.FileType = msoFileTypeExcelWorkbooks
.Filename = "Tabelle1.xls"
If .Execute > 0 Then
Set wb = Workbooks.Open(Filename:=.FoundFiles(1), UpdateLinks:=0)
Daten_Einlesen
wb.Close SaveChanges:=True
End If
End With
On Error GoTo 0
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub

Gruss!
Tassos
Anzeige
AW: Datei suchen
HansHei
Hallo Norman,
ich würde die Werte aus einer anderen Datei so holen:
Sub kopieren()
Application.Dialogs(xlDialogOpen).Show
    With Workbooks("Quelldatei_B.xls").Sheets("RefDat")
    .Columns("A:B").Copy Workbooks("Zieldatei_B.xls").Sheets("RefDat").Range("C1")
    End With
ActiveWindow.Close
End Sub
Das kann ich noch nachvollziehen und ohne großartiges Formelstudium ggf. meinen Bedürfnissen anpassen.
Gruß
Hans
Anzeige
falls Du abbrechen musst
HansHei
Sub kopieren()
Application.ScreenUpdating = False
    Application.Dialogs(xlDialogOpen).Show 'aktivieren des Dialogs
On Error GoTo Ende 'bei Abbruch gehe zu Ende:
    With Workbooks("Quelldatei_B.xls").Sheets("RefDat")
    .Columns("A:B").Copy Workbooks("Zieldatei_B.xls").Sheets("RefDat").Range("C1")
    End With
ActiveWindow.Close
Ende:
Application.ScreenUpdating = True
End Sub
Anzeige
AW: falls Du abbrechen musst
23.04.2006 11:43:17
Norman
Vielen Dank für Eure Hilfen.

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige