A bit "wordy", but it does the job.
Stuff this in a module, and then call GetNewFileName from where ever
you wish, whenever you wish.
Option Compare Database
Option Explicit
Private Declare Function lstrcpyA _
Lib "kernel32" _
(ByVal RetVal As String, _
ByVal ptr As Long) _
As Long
Private Declare Function lstrlenA _
Lib "kernel32" _
(ByVal ptr As Any) _
As Long
Private Declare Function PathRemoveFileSpec _
Lib "shlwapi" _
Alias "PathRemoveFileSpecA" _
(ByVal pPath As String) _
As Long
Private Declare Function PathRemoveExtension _
Lib "shlwapi" _
Alias "PathRemoveExtensionA" _
(ByVal pPath As String) _
As Long
Private Declare Function PathFindExtension _
Lib "shlwapi" _
Alias "PathFindExtensionA" _
(ByVal pPath As String) _
As Long
Private Declare Function PathFindFileName _
Lib "shlwapi" _
Alias "PathFindFileNameA" _
(ByVal pPath As String) _
As Long
Private Declare Function PathStripPath _
Lib "shlwapi" _
Alias "PathStripPathA" _
(ByVal pPath As String) _
As Long
Private Declare Function PathAddBackslash _
Lib "SHLWAPI.DLL" _
Alias "PathAddBackslashA" _
(ByVal Path As String) _
As Long
Private Const MAX_PATH As Long = 260
Private Function GetFileTitle(ByVal sPath As String) As String
GetFileTitle = StripExtension(GetFilePart(sPath))
End Function
Private Function GetPathPart( _
ByVal sPath As String, _
Optional ByVal bolAddFinalSlash As Boolean = True) _
As String
Call PathRemoveFileSpec(sPath)
GetPathPart = TrimNull(sPath)
If bolAddFinalSlash = True Then
GetPathPart = AddBackslash(GetPathPart)
End If
End Function
Private Function GetExtensionPart(ByVal sPath As String) As String
GetExtensionPart = GetStrFromPtrA(PathFindExtension(sPath))
End Function
Private Function TrimNull(ByVal Item As String)
Dim pos As Integer
pos = InStr(Item, Chr$(0))
If pos Then
TrimNull = Left$(Item, pos - 1)
Else: TrimNull = Item
End If
End Function
Private Function GetStrFromPtrA(ByVal lpszA As Long) As String
'Given a pointer to a string, return the string
GetStrFromPtrA = String$(lstrlenA(ByVal lpszA), 0)
Call lstrcpyA(ByVal GetStrFromPtrA, ByVal lpszA)
End Function
Private Function GetFilePart(ByVal sPath As String) As String
GetFilePart = GetStrFromPtrA(PathFindFileName(sPath))
End Function
Private Function AddBackslash(ByVal sPath As String) As String
Dim lngResult As Long
Dim strBuffer As String
strBuffer = Left$(sPath & String(MAX_PATH, vbNullChar), MAX_PATH)
lngResult = PathAddBackslash(strBuffer)
If lngResult <> 0 Then
AddBackslash = Left$(strBuffer, _
InStr(strBuffer, _
vbNullChar) - 1)
End If
End Function
Private Function StripExtension(ByVal sPath As String) As String
Call PathRemoveExtension(sPath)
StripExtension = TrimNull(sPath)
End Function
Public Function GetNewFileName( _
ByVal strOriginalFileName As String, _
ByVal strNewPath As String, _
Optional ByVal strNewExtenstion As String = "") _
As String
Dim strTemp As String
strTemp = AddBackslash(strNewPath)
If strNewExtenstion = "" Then
strTemp = strTemp & GetFilePart(strOriginalFileName)
Else
strTemp = strTemp & _
GetFileTitle(strOriginalFileName)
If Left$(strNewExtenstion, 1) <> "." Then
strTemp = strTemp & "."
End If
strTemp = strTemp & strNewExtenstion
End If
GetNewFileName = strTemp
End Function
Anyone know how to rename a file, but with the original extension?
For instance,
FileCopy (C:\ImageName.jpg, \\Server\Images\Image_GuestID.jpg)
I was assigning a file name using something like "\\Server\Images" &
"_" & [GuestID] & .dib but then when I added the ability to link to
jpg's, (which are then copied to the Server file as above) I realized
this wasn't going to work. So, I'm looking for something that will
get the type of file that the original was and rename it as the same
type of file.
