Datei von Verzeichnis aktivieren

Guten Abend,
ich habe ein kniffffflige Frage:
Ich möchte eine Datei von einem Netzwerk_Laufwerk
erst auf C:\ kopieren dann aktivieren.
Das Problem:
Die Datei möchte ich gern aus mehreren Monatsverzeichnissen aussuchen
also ein bestimmtes Verzeichnis öffnen dann kopieren auf C: und dann öffnen.
Habe dies schon:
Dim OrdVerz As String
OrdVerz = "V:\"
'-------------------------------------------------------------------
If Dir(OrdVerz, 16) "" Then
MsgBox "Verzeichnis: '" & OrdVerz & "' ist vorhanden !" & Chr(13) _
& " Sie können jetzt kopieren ! ", vbInformation, " Hinweis !"
Dim fso
Dim Datei As String
Datei = "c:\1_Lager\Liste.xls"
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CopyFile "V:\Lager\Liste.xls", _
"C:\Lager\"
Workbooks.Open Datei
Else
MsgBox "Verzeichnis '" & OrdVerz & "' ist nicht vorhanden ! " & Chr(13) _
& vbCr & "Keine Netzwerkverbindung !" & Chr(13), vbCritical
End If
mfg Walter mg

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Sub Test() Dim FSO As Object, F1 As Object Dim sZiel As String, sQuelle As String sQuelle = "c:\1_Lager\Liste.xls" 'Quelle sZiel = "C:\Lager\" 'Ziehl Set FSO = CreateObject("Scripting.FileSystemObject") If FSO.fileExists(sQuelle) And FSO.folderexists(sZiel) Then Set F1 = FSO.GetFile(sQuelle) On Error Resume Next F1.Copy sZiel If Err.Number = 0 Then Workbooks.Open sZiel & Right$(sQuelle, Len(sQuelle) - InStrRev(sQuelle, "\")) Else MsgBox Err.Number & String(2, Chr(13)) & Err.Description, "Fehler" End If Set F1 = Nothing Else MsgBox "Ziel oder Quelle nicht vorhanden!", vbCritical End If Set FSO = Nothing End Sub

Hallo,
habe ich hiermit richtig verstanden?

Sub Test()
Dim FSO As Object, F1 As Object
Dim sZiel As String, sQuelle As String
Dim sOrdner As String
 
ChDrive "Z:\"
ChDir "Z:\1_Lager\"
 
sQuelle = Application.GetOpenFilename("Excel Files (*.xls), *.xls") 'Quelle 
 If sQuelle = "Falsch" Then Exit Sub 'Auswahl abgebrochen 

sOrdner = Right$(sQuelle, Len(sQuelle) - InStrRev(sQuelle, "\") + 1)
sOrdner = Right$(Replace(sQuelle, sOrdner, ""), Len(Replace(sQuelle, sOrdner, "")) - _
          InStrRev(Replace(sQuelle, sOrdner, ""), "\") + 1) & sOrdner

sZiel = "C:\Lager" & sOrdner 'Ziehl 
 
Set FSO = CreateObject("Scripting.FileSystemObject")
     
    If FSO.fileExists(sQuelle) And FSO.folderexists(sZiel) Then
        Set F1 = FSO.GetFile(sQuelle)
         
        On Error Resume Next
        F1.Copy sZiel
        
       If Err.Number = 0 Then
        Workbooks.Open sZiel & Right$(sQuelle, Len(sQuelle) - InStrRev(sQuelle, "\"))
       Else
        MsgBox Err.Number & String(2, Chr(13)) & Err.Description, "Fehler"
       End If
        Set F1 = Nothing
     
    Else
      
        MsgBox "Ziel oder Quelle nicht vorhanden!", vbCritical
     
    End If
 
Set FSO = Nothing
End Sub

Gruß Tino

Sub Test() Dim FSO As Object, F1 As Object Dim sZiel As String, sQuelle As String Dim sOrdner As String ChDrive "Z:\" ChDir "Z:\Lager\" sQuelle = Application.GetOpenFilename("Excel Files (*.xls), *.xls") 'Quelle If sQuelle = "Falsch" Then Exit Sub 'Auswahl abgebrochen sOrdner = Right$(sQuelle, Len(sQuelle) - InStrRev(sQuelle, "\") + 1) sOrdner = Right$(Replace(sQuelle, sOrdner, ""), Len(Replace(sQuelle, sOrdner, "")) - _ InStrRev(Replace(sQuelle, sOrdner, ""), "\") + 1) & sOrdner sZiel = "C:\Werkstatt\Lager" & sOrdner 'Ziehl Set FSO = CreateObject("Scripting.FileSystemObject") If FSO.fileExists(sQuelle) And FSO.folderexists(Left$(sZiel, InStrRev(sZiel, "\"))) Then Set F1 = FSO.GetFile(sQuelle) On Error Resume Next F1.Copy sZiel If Err.Number = 0 Then Workbooks.Open sZiel Else MsgBox Err.Number & String(2, Chr(13)) & Err.Description, "Fehler" End If Set F1 = Nothing Else MsgBox "Ziel oder Quelle nicht vorhanden!", vbCritical End If Set FSO = Nothing End Sub

Beliebteste Forumthreads (12 Monate)

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread