Private Function Fixa(s As String) As String
Dim R As Boolean
Dim A() As String
Dim I As Integer, J As Integer
Dim D As String
If Right(s, 1) = "\" Then
R = True
s = Mid(s, 1, Len(s) - 1)
End If
A = Split(s, "\")
A(0) = UCase(A(0))
For I = UBound(A) To 1 Step -1
D = ""
For J = 0 To I
D = D & A(J) & "\"
Next
D = Mid(D, 1, Len(D) - 1)
A(I) = Dir(D, vbDirectory)
If A(I) = "" Then
ReDim A(0)
A(0) = "Mappen kunde inte hittas"
R = False
Exit For
End If
Next
D = Join(A, "\")
If R Then Fixa = D & "\" Else Fixa = D
End Function