AW: Datenabruf - Kopie einer Datei zuerst öffnen
14.01.2025 16:42:38
ChrisWe
Nungut, ich sehe schon es ist etwas umständlicher als gedacht.
Das andere Programm erstellt eine Export Datei, die im persönlichen Download Ordner landet. Da nicht nur ich die Tabelle verwende, ist es so geschrieben, dass der Persönliche Download Ordner angezogen wird.
Hier mal der ganze Code:
Sub Import()
Dim Pfad As String
Dim Datei As String
Dim Dateipfad As String
Dim d As String
Dim m As String
Dim y As String
Dim tag As String
Dim shift As String
tag = Worksheets("Tabelle1").Range("J3").Value
shift = Worksheets("Tabelle1").Range("A4").Value
ActiveSheet.Range("P5").Value = ""
Worksheets("Tabelle3").Range("A7:J61").ClearContents
y = CStr(Year(Now))
m = Right("0" + CStr(Month(Now)), 2)
d = Right("0" + CStr(Day(Now)), 2)
Pfad = "C:\Users\" & Environ("UserName") & "\Downloads\"
Datei = "export_" & d & "-" & m & "-" & y & " (3)" & ".xls"
Dateipfad = Pfad & Datei
FehlerA:
Datei = "export_" & d & "-" & m & "-" & y & ".xls"
Dateipfad = Pfad & Datei
GoTo contA
FehlerB:
Datei = "export_" & d & "-" & m & "-" & y & " (1)" & ".xls"
Dateipfad = Pfad & Datei
GoTo contB
FehlerC:
Datei = "export_" & d & "-" & m & "-" & y & " (2)" & ".xls"
Dateipfad = Pfad & Datei
GoTo contC
Fehler:
Worksheets("Tabelle1").Range("P5").Value = "Keine Datei gefunden"
GoTo Ende
contA:
On Error GoTo Fehler
Workbooks.Open Filename:=Dateipfad
GoTo cont
contB:
On Error GoTo FehlerA
Workbooks.Open Filename:=Dateipfad
GoTo cont
contC:
On Error GoTo FehlerB
Workbooks.Open Filename:=Dateipfad
GoTo cont
On Error GoTo FehlerC
Workbooks.Open Filename:=Dateipfad
cont:
Calculate
If tag > 0.53 And shift = "Früh - Mittel" Then
m = Right("0" + CStr(Month(Now + 1)), 2)
d = Right("0" + CStr(Day(Now + 1)), 2)
Else
m = Right("0" + CStr(Month(Now)), 2)
d = Right("0" + CStr(Day(Now)), 2)
End If
Range(Cells(6, 1), Cells(60, 10)).Select
Selection.Copy
ThisWorkbook.Sheets("Tabelle3").Activate
ActiveSheet.Range("X3").Value = d
ActiveSheet.Range("Y3").Value = m
ActiveSheet.Range("Z3").Value = y
Sheets("Tabelle3").Cells(7, 1).Select
ActiveSheet.Paste
' Rohdatendatei schließen
Application.CutCopyMode = False
Workbooks(Datei).Close (False)
GoTo Ende
Ende:
Calculate
Dim zähler As Single
Dim ZelleA As String
Dim ZelleB As String
Dim ZelleC As String
Dim ZelleD As String
Dim ZelleL As String
Dim ZelleN As String
Dim ZelleO As String
Dim ZelleP As String
Dim ZelleR As String
Dim ZelleS As String
Dim AZ As String
Dim DZ As String
Dim Abfrage As String
zähler = 7
Do Until zähler = 51
ZelleA = "A" & zähler
ZelleB = "B" & zähler
ZelleC = "C" & zähler
ZelleD = "D" & zähler
ZelleL = "L" & zähler
ZelleN = "N" & zähler
ZelleO = "O" & zähler
ZelleP = "P" & zähler
ZelleR = "R" & zähler
ZelleS = "S" & zähler
Abfrage = ActiveSheet.Range(ZelleA).Value
If Abfrage = "" Then
ElseIf ActiveSheet.Range(ZelleL).Value = 0 Then
AZ = ActiveSheet.Range(ZelleN).Value
DZ = ActiveSheet.Range(ZelleO).Value
Worksheets("Tabelle1").Range(ZelleC).Value = AZ & DZ
Worksheets("Tabelle1").Range(ZelleA).Value = ActiveSheet.Range(ZelleA).Value
Worksheets("Tabelle1").Range(ZelleB).Value = ActiveSheet.Range(ZelleB).Value
Else
Worksheets("Tabelle1").Range(ZelleC).Value = "NS"
Worksheets("Tabelle1").Range(ZelleA).Value = ActiveSheet.Range(ZelleA).Value
Worksheets("Tabelle1").Range(ZelleB).Value = ActiveSheet.Range(ZelleB).Value
End If
If Abfrage = "" Then
ElseIf ActiveSheet.Range(ZelleP).Value = 0 Then
AZ = ActiveSheet.Range(ZelleR).Value
DZ = ActiveSheet.Range(ZelleS).Value
Worksheets("Tabelle1").Range(ZelleD).Value = AZ & DZ
Else
Worksheets("Tabelle1").Range(ZelleD).Value = "NS"
End If
zähler = zähler + 1
Loop
Worksheets("Tabelle3").Range("A7:J61").ClearContents
ThisWorkbook.Sheets("Tabelle1").Activate
End Sub