Datei "umspeichern" - VBA
21.09.2008 14:46:00
Wolfgang
mit untenstehendem Code werden Daten aus einer tmp-Datei importiert. Es wird immer die zuletzt generierte Datei angesprochen. Seit geraumer Zeit wird nun diese tmp-Datei in einem UTF-8-Format "geliefert", welches dazu führt, dass die Umlaute nicht sauber importiert werden. Nun kam mir die Idee, ob nicht eine Möglichkeit besteht, diese jeweilige Datei entweder neu zu speichern in ANSI oder direkt das Format von UTF in ANSI zu konvertieren. Wäre so etwas denkbar ? - Herzlichen Dank schon jetzt für die Rückmeldungen.
Gruß - Wolfgang
Public Sub TestT()
Dim strUser As String, strPath As String, strhelp As String
' Dein Teil für den UserNamen
strUser = Environ("Username")
strUser = Trim$(Replace(strUser, "GST", ""))
' Zusammenbauen des Pfades aus Vorgabepfad und UserName
strPath = "C:\WINDOWS\Temp\" & strUser & "\Temp"
If Dir(strPath, vbDirectory) = "" Then
MsgBox "Das angegebene Verzeichnis existiert nicht!", vbCritical
Exit Sub
End If
Sheets("Daten").Activate
' Nun noch das TEXT; davor & Aufruf der Function die die neuste Tmp Datei als String zurückgibt. _
_
strhelp = FindNewestTemp(strPath)
If strhelp "" Then
strPath = "TEXT;" & strhelp
Else
MsgBox "Es wurde keine TMP Datei im angegebenen Verzeichnis gefunden!", vbCritical
Exit Sub
End If
' Und nun nur noch importieren, fertig !!!
With ActiveSheet.QueryTables.Add(Connection:=strPath, Destination:=Range("A1"))
.Refresh
' ChDrive "C"
End With
End Sub
Public Function FindNewestTemp(strPath As String) As String
Dim strFile As String
Dim datNewestDate As Date
Dim myFileSystemObject, myFiles
If Right(strPath, 1) "\" Then strPath = strPath & "\"
Set myFileSystemObject = CreateObject("Scripting.FileSystemObject")
For Each myFiles In myFileSystemObject.GetFolder(strPath).Files
If UCase(myFileSystemObject.GetExtensionName(strPath & myFiles.Name)) = "TMP" Then
If myFiles.DateCreated > datNewestDate Then
datNewestDate = myFiles.DateCreated
strFile = myFiles.Name
End If
End If
Next myFiles
If strFile "" Then
FindNewestTemp = strPath & strFile
Else
FindNewestTemp = ""
End If
End Function