Function GetFilePath(FileName As String) As String
Dim i As Long
For i = Len(FileName) To 1 Step -1
Select Case Mid$(FileName, i, 1)
Case ":"
' colons are always included in the result
GetFilePath = Left$(FileName, i)
Exit For
Case "\"
' backslash aren't included in the result
GetFilePath = Left$(FileName, i - 1)
Exit For
End Select
Next
End Function
Function ReturnFileName(sFileName As String) As String
Dim Start As Long
Dim tmpFileName As String
tmpFileName = sFileName
Start = Len(tmpFileName) 'get the length of the string
If InStr(tmpFileName, "\") = 0 Or Start = 0 Then Exit Function 'check for valid string
Do
tmpFileName = Mid(tmpFileName, 1, Start)
If Right(tmpFileName, 1) <> "\" Then Start = Start - 1 'move backwards through string looking for '\'
Loop Until Right(tmpFileName, 1) = "\"
ReturnFileName = Trim(Mid(sFileName, Start + 1, Len(sFileName)))
End Function
Sub CreateNewDirectory(dirname As String)
Dim NewLen As Integer
Dim DirLen As Integer
Dim MaxLen As Integer
NewLen = 4
MaxLen = Len(dirname)
If Right$(dirname, 1) <> "\" Then
dirname = dirname + "\"
MaxLen = MaxLen + 1
End If
On Error GoTo DirError
MakeNext:
DirLen = InStr(NewLen, dirname, "\")
MkDir Left$(dirname, DirLen - 1)
NewLen = DirLen + 1
If NewLen >= MaxLen Then
Exit Sub
End If
GoTo MakeNext
DirError:
Resume Next
End Sub
Function LoadFileAtOnce(Filename As String) As String
Dim strText As String
Dim FNbr As Integer
If Dir(Filename) = "" Then
MsgBox "Fil: " & Filename & " hittas inte!" & vbLf & "Kan inte läsa in filen till en variabel.", vbExclamation, "Filen hittas inte"
Exit Function
End If
On Error GoTo ErrorHandler
FNbr = FreeFile
Open Filename For Binary As #FNbr
strText = Space$(LOF(FNbr))
Get #FNbr, , strText
Close #FNbr
Exit Function
ErrorHandler:
MsgBox Err.Number & Err.Description, vbCritical, "Fel"
Close #FNbr
End Function
Function LoadFileAtOnceFSO(Filename As String) As String
Dim objFSO As Object
Dim objTF As Object
Dim strText As String
On Error GoTo ErrorHandler
Set objFSO = CreateObject("Scripting.FileSystemObject")
If Not objFSO.FileExists(Filename) Then
MsgBox "Fil: " & Filename & " hittas inte!" & vbLf & "Kan inte läsa in filen till en variabel.", vbExclamation, "Filen hittas inte"
Exit Function
End If
Set objTF = objFSO.OpenTextFile(Filename, 1)
strText = objTF.readall
objTF.Close
Set objTF = Nothing
Set objFSO = Nothing
LoadFileAtOnceFSO = strText
Exit Function
ErrorHandler:
MsgBox Err.Number & Err.Description, vbCritical, "Fel"
objTF.Close
Set objTF = Nothing
Set objFSO = Nothing
End Function
Function LoadFileAtOnceUTF8(Filename As String) As String
Dim objFSO As Object
Dim strText As String
Dim objStream As Object
On Error GoTo ErrorHandler
Set objFSO = CreateObject("Scripting.FileSystemObject")
If Not objFSO.FileExists(Filename) Then
MsgBox "Fil: " & Filename & " hittas inte!" & vbLf & "Kan inte läsa in filen till en variabel.", vbExclamation, "Filen hittas inte"
Exit Function
End If
Set objStream = CreateObject("ADODB.Stream")
objStream.Charset = "utf-8"
objStream.Open
objStream.LoadFromFile Filename
strText = objStream.ReadText()
objStream.Close
LoadFileAtOnceUTF8 = strText
Exit Function
ErrorHandler:
MsgBox Err.Number & Err.Description, vbCritical, "Fel"
objStream.Close
Set objStream = Nothing
Set objFSO = Nothing
End Function
Sub writeOut(Filename As String, txt As String)
Dim fso As Object
On Error GoTo ErrorHandler
Set fso = CreateObject("ADODB.Stream")
fso.Type = 2
fso.Charset = "utf-8"
fso.Open
fso.writetext txt
fso.SaveToFile Filename, 2
Exit Sub
ErrorHandler:
MsgBox (Err.Description)
End Sub