'Copiare le due funzioni in un form ed utilizzare la
'unzione TruncatePath nel seguente modo: PathRistretto = TruncatePath(PathLungo, MaxLunghezza) Private Function TruncatePath(ByVal sFileName As String, iMaxLen as Integer) As String If Len(sFileName) Then Dim iPos As Integer, iPos0 As Integer, _ iPos1 As Integer, iPos2 As Integer, _ iPos3 As Integer, iPos4 As Integer iPos = SGBkwdInstrS(0, Left$(sFileName, Len(sFileName) - 1), "\") iPos0 = InStr(sFileName, ":") iPos1 = InStr(sFileName, "\") iPos2 = InStr(iPos1, sFileName, "\"): iPos2 = iPos1 + iPos2 iPos3 = InStr(iPos2, sFileName, "\"): iPos3 = iPos2 + iPos3 iPos4 = InStr(iPos3, sFileName, "\"): iPos4 = iPos3 + iPos4 If Len(sFileName) > iMaxLen Then If (iPos4 <> 0) And iPos4 +Len(Right(sFileName, iPos)) <= iMaxLen - 2 Then sFileName = Left$(sFileName, iPos4) & "..." & Right(sFileName, Len(sFileName) - iPos) ElseIf (iPos3 > 0) And iPos3 + Len(Mid$(sFileName, iPos)) <= iMaxLen - 2 Then sFileName = Left$(sFileName, iPos3) & "..." & Right(sFileName, Len(sFileName) - iPos) ElseIf (iPos3 > 0) And iPos3 + Len(Mid$(sFileName, iPos)) <= iMaxLen - 2 Then sFileName = Left$(sFileName, iPos2) & "..." & Right(sFileName, Len(sFileName) - iPos) Else sFileName = Left$(sFileName, iPos0 + 1) & "..." & Right(sFileName, Len(sFileName) - iPos) End If End If End If TruncatePath = Left$(sFileName, Len(sFileName) - 1) End Function Funzione accessoria... Function SGBkwdInstrS(ByVal iStart As Integer, ByVal sTarget As String, _ ByVal SPattern As String) Dim IPtr As Integer, IPLen As Integer IPLen = Len(SPattern) If ((Len(sTarget) = zero) Or (IPLen = zero) Or (Len(SPattern) > Len(sTarget))) Then Exit Function If (iStart = zero) Then iStart = 1 If (iStart >= (Len(sTarget))) Then iStart = Len(sTarget) iStart = Len(sTarget) - iStart + 1 On Error Resume Next For IPtr = iStart To 1 Step True If (SPattern = Mid$(sTarget, IPtr, IPLen)) Then 'found it SGBkwdInstrS = IPtr Exit For End If Next IPtr End Function |