Themabewertung:
  • 0 Bewertung(en) - 0 im Durchschnitt
  • 1
  • 2
  • 3
  • 4
  • 5
Umbenennen einer Datei
#3
Danke für den Tipp, ich habe aufjedenfall neue Befehle kennengelertn. Leider funktioniert auch dieser Code nicht fehlerfrei denn diesmal bekomm ich den Fehler : "Laufzeitfehler 70: Zugriff verweigert", was aber auch wieder komisch ist, dass durch nochmaliges Fortsetzen des Codes der Fehler wieder ignoriert wird und der Code bis zum Ende wie gewünscht weiter läuft.

Hier ist mein gesamter Code, vielleicht liegt ja auch irgendwo anders das Problem.

    Dim DateiName As String
    Dim Zeit1 As Date
    Dim Zeit2 As String
    Dim Datum1 As Date
    Dim Datum2 As String
    Dim dieUrl As String
    Dim DateiPfadzip As String
    Dim myResult
    Dim StationsID As String
    Dim Zählen1 As Integer
    Dim Zählen2 As Integer
    Dim Zählen3 As Integer
    Dim Zählen4 As Integer
    Dim Zählen5 As Integer
    Dim strFileName As String
    Dim DateiExist As String
    Dim DateiNameZip As String
    Dim DateiNameTxt As String
    Dim Name As String
    Dim Test As String
    Dim DownloadOrdner As String
    Dim Pfad As String
    Dim NameUrsprung As String
    Dim NameZiel As String
    Dim Laufdatei As String
    Dim ArchivOrdner As String
   
Option Explicit

Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" _
    Alias "URLDownloadToFileA" ( _
    ByVal pCaller As Long, _
    ByVal szURL As String, _
    ByVal szFileName As String, _
    ByVal dwReserved As Long, _
    ByVal lpfnCB As Long) As Long
   
   
Sub Prognose()
    Datum1 = Date  'aktuelles Datum wird in einer Datum Variable gespeichert
    Datum2 = Format(Datum1, "YYYYMMDD" & "09")  'aktuelles Datum wird in einem String gespeichert
    StationsID = Sheets("Rechner2").Cells(20, 4)    'Die StationsId wird in einer Variable gespeichert
    Zeit1 = Format(Now, "h:mmConfuseds")  'aktuele Uhrzeit wird in einer Zeit Variable gespeichert
    Zeit2 = Format(Zeit1, "hmmss")  'aktuele Uhrzeit wird in einem String gespeichert
       
    Call GetExcelfolder
    'DownloadOrdner = "C:\HSNR\ELMAR\Wärmenetz\Test_Ordner\"
   
    Do
        Zählen1 = Zählen1 + 1
    Loop Until DownloadOrdner <> ""
   
    Call Ordner
    Call Download
   
    Do
        Zählen2 = Zählen2 + 1
        DateiExist = Dir(DownloadOrdner)
        DateiNameZip = DateiExist
    Loop Until DateiExist <> ""
   
    Name DownloadOrdner & DateiNameZip As ArchivOrdner & DateiNameZip
   
    Do
        Zählen3 = Zählen3 + 1
    Loop Until Dir(ArchivOrdner & DateiExist) <> ""
   
    Call Packen
       
    Do
        DateiExist = ""
        DateiExist = Dir(DownloadOrdner)
        DateiNameTxt = DateiExist
        Zählen4 = Zählen4 + 1
    Loop Until DateiExist <> ""
     
    Call Umbenennen
    DateiExist = ""
       
    Do
        Zählen5 = Zählen5 + 1
        DateiExist = Dir(DownloadOrdner)
        DateiNameTxt = DateiExist
    Loop Until DateiExist = DateiName & ".txt"
   
   
    Call Importieren
    Call Sheetadd
   
    Name DownloadOrdner & DateiNameTxt As ArchivOrdner & DateiName & Zeit2 & ".txt"
   
    End
   
End Sub
Public Sub Download()
    dieUrl = "https://opendata.dwd.de/weather/local_forecasts/mos/MOSMIX_L/single_stations/" & StationsID & "/kml/MOSMIX_L_LATEST_" & StationsID & ".kmz"
    DateiPfadzip = DownloadOrdner & "\MOSMIX_L_LATEST_" & Datum2 & "_" & StationsID & "_" & Zeit2 & ".zip"
    myResult = URLDownloadToFile(0, dieUrl, DateiPfadzip, 0, 0)
End Sub
Sub Packen()
    Pfad = "C:\Programme\WinRAR\WinRAR.exe e " & ArchivOrdner & DateiExist & " " & DownloadOrdner
    Shell (Pfad)
End Sub
Public Sub Umbenennen()
    Do
    NameUrsprung = DownloadOrdner & DateiExist
    Loop Until NameUrsprung <> ""
   
    DateiName = Left(DateiExist, Len(DateiExist) - 4)
   
    Do
    NameZiel = DownloadOrdner & DateiName & ".txt"
    Loop Until NameZiel <> ""
    FileCopy NameUrsprung, NameZiel
    Kill NameUrsprung
    'FileCopy "C:\HSNR\ELMAR\Wärmenetz\Test_Ordner\MOSMIX_L_2019112209_N8527.kml", "C:\HSNR\ELMAR\Wärmenetz\Test_Ordner\MOSMIX_L_2019112209_N8527.txt"
    'Kill "C:\HSNR\ELMAR\Wärmenetz\Test_Ordner\MOSMIX_L_2019112209_N8527.kml"
    'Name "C:\HSNR\ELMAR\Wärmenetz\Test_Ordner\MOSMIX_L_2019112209_N8527.kml" As "C:\HSNR\ELMAR\Wärmenetz\Test_Ordner\MOSMIX_L_2019112209_N8527.txt"
    'Name "C:\HSNR\ELMAR\Wärmenetz\Test Ordner\MOSMIX_L_2019111309_N8527.kml" As "C:\HSNR\ELMAR\Wärmenetz\Test Ordner\MOSMIX_L_2019111309_N8527.txt"
End Sub
Sub Importieren()
    Workbooks.OpenText Filename:=NameZiel, _
        Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, _
        Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _
        Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1)), TrailingMinusNumbers _
        :=True
End Sub
Public Function GetExcelfolder() As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Title = "Bitte Ordner wählen"
        .InitialFileName = "C:\"
        .InitialView = msoFileDialogViewThumbnail
        .ButtonName = "OK"
        If .Show = -1 Then
            GetExcelfolder = .SelectedItems(1)
        End If
        DownloadOrdner = GetExcelfolder & "\"
    End With
End Function


Sub Sheetadd()
    Windows(DateiExist).Activate
    Sheets(DateiName).Select
    Sheets(DateiName).Copy After:=Workbooks( _
        "Berechnung_Wärmenetz(Beta_V6)xlsb.xlsm").Sheets(9)
    Workbooks(DateiExist).Close SaveChanges:=False
End Sub
Sub Ordner()
ArchivOrdner = DownloadOrdner & "Archiv\"
If Dir(ArchivOrdner, vbDirectory) = "" Then
  MkDir (ArchivOrdner)
Else
 
End If
End Sub
Zitieren


Nachrichten in diesem Thema
Umbenennen einer Datei - von Niko - 22.11.2019, 16:06
RE: Umbenennen einer Datei - von maninweb - 22.11.2019, 18:22
RE: Umbenennen einer Datei - von Niko - 22.11.2019, 22:01
RE: Umbenennen einer Datei - von maninweb - 24.11.2019, 14:45
RE: Umbenennen einer Datei - von Niko - 24.11.2019, 18:14
RE: Umbenennen einer Datei - von maninweb - 24.11.2019, 19:08
RE: Umbenennen einer Datei - von Niko - 10.12.2019, 17:49
RE: Umbenennen einer Datei - von maninweb - 11.12.2019, 11:18
RE: Umbenennen einer Datei - von Niko - 13.12.2019, 12:08

Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste




Hinweis auf Angebot Excel-Inside - lang    Keine Lösung gefunden? Du kannst Dich gerne an unser erfahrenes Experten-Team wenden um dein Anliegen zu besprechen.
   Gerne erstellen wir auf dieser Basis ein Angebot.
   Sende deine Anfrage einfach
per E-Mail an anfrage@excel-inside.de


Powerd and supported by Excel-InsideSolutions