Estou disponibilizando estes módulos que contém três procedimentos relacionados com arquivos e pastas temporárias.
O primeiro procedimento, GetTempFolderName, retorna o nome da pasta que está configurada para arquivos temporários no usuário atual. Ela retorna o nome da pasta que o sistema tenha especificado para o usuário atual para armazenar os arquivos temporários.
O segundo procedimento, GetTemporaryFolderName, é usado para obter o nome de uma pasta temporária e, opcionalmente, criá-la. Esta pasta será criada na pasta do usuário do sistema, temp, retornado pela função GetTempFolderName.
O terceiro processo, GetTempFile, é usado para obter o nome do arquivo que está garantido para ser exclusivo dentro da pasta na qual ele for criado.
A documentação de cada procedimento está incluído no próprio código .
Para que estes funcionem, usem a função GetSystemErrorMessageText, disponível aqui; e a função TrimToNull também disponível aqui.
Public Function TrimToNull (S As String) As String''''''''''''''''''''''''''''''''''''''''''''''''''''' TrimToNull' This returns the portion of the string S that' is to the left of the first vbNullChar character.' If vbNullChar is not found, the entire string is' returned.''''''''''''''''''''''''''''''''''''''''''''''''''''Dim Pos As IntegerPos = InStr(1, S, vbNullChar)If Pos > 0 ThenTrimToNull = Left(S, Pos - 1)ElseTrimToNull = SEnd IfEnd FunctionOption ExplicitOption Compare Text'''''''''''''''''''''''''''''''''''' Maximum Length Of Full File Name'''''''''''''''''''''''''''''''''''Private Const MAX_PATH = 260 ' Windows Standard, from VC++ StdLib.hPrivate Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" ( _ByVal lpszPath As String, _ByVal lpPrefixString As String, _ByVal wUnique As Long, _ByVal lpTempFileName As String) As LongPrivate Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" ( _ByVal nBufferLength As Long, _ByVal lpBuffer As String) As LongPrivate Declare Function PathGetCharType Lib "shlwapi.dll" _Alias "PathGetCharTypeA" ( _ByVal ch As Byte) As Long
GetTempFolderName
Public Function GetTempFolderName( _Optional IncludeTrailingSlash As Boolean = False) As String''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' GetTempFolder' This procedure returns the name of the folder that the system has designated' for temporary files for the current user.' Returns the name of the folder or vbNullString if an error' occurred. The argument IncludeTrailingSlash indicates whether to include a' trailing slash at the end of the folder name.''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Dim TempPath As StringDim Length As LongDim Result As LongDim ErrorNumber As LongDim ErrorText As String''''''''''''''''''''''''''''''''''''''' Initialize the variables''''''''''''''''''''''''''''''''''''''TempPath = String(MAX_PATH, " ")Length = MAX_PATH'''''''''''''''''''''''''''''''''''''''''''''''''' Get the Temporary Path using GetTempPath.'''''''''''''''''''''''''''''''''''''''''''''''''Result = GetTempPath(Length, TempPath)If Result = 0 Then'''''''''''''''''''''''''''''''''''''' An error occurred'''''''''''''''''''''''''''''''''''''ErrorNumber = Err.LastDllErrorErrorText = GetSystemErrorMessageText(ErrorNumber)MsgBox "An error occurred getting the temporary folder" & _" from the GetTempFolderName function: " & vbCrLf & _"Error: " & CStr(ErrorNumber) & " " & ErrorTextGetTempFolderName = vbNullStringExit FunctionElse'''''''''''''''''''''''''''''''''''''''' No error, but the buffer may have' been too small.'''''''''''''''''''''''''''''''''''''''If Result > Length Then''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' The buffer TempPath was too small to hold the folder name.' This should never happen if MAX_PATH is set to the proper' value.''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''MsgBox "The TempPath buffer is too small. It is allocated at " & _CStr(Length) & " characters." & vbCrLf & _"The required buffer size is: " & CStr(Result) & " characteres.", _vbOKOnly, "GetTempFolderName"GetTempFolderName = vbNullStringExit FunctionEnd If' trim up the TempPath. It includes a trailing "\"TempPath = TrimToNull(Text:=TempPath)If IncludeTrailingSlash = False Then'''''''''''''''''''''''''''''''''''''''''''''''''' If IncludeTrailingSlash is false, get rid of' the trailing slash.'''''''''''''''''''''''''''''''''''''''''''''''''TempPath = Left(TempPath, Len(TempPath) - 1)End IfEnd IfGetTempFolderName = TempPathEnd Function
GetTemporaryFolderName
Public Function GetTemporaryFolderName(Optional Create As Boolean = False) As String'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' GetTemporaryFolderName' This function returns the name of a temporary folder name. The folder will be' in the user's designated temp folder. If Create is True, the folder will' be created.'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Dim FName As StringDim FileName As StringDim TempFolderName As StringDim Pos As Integer''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Get a temp file name with no extension, located in the' user's system-specified temporary folder.''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''FName = GetTempFile(vbNullString, vbNullString, " ", False)''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Find the location of the last "\" character.''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Pos = InStrRev(FName, "\", -1, vbTextCompare)''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Get the filename (without the path) of the temp file.''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''FileName = Mid(FName, Pos + 1)''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Get the user's system-specified temp folder name''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''TempFolderName = GetTempFolderName(IncludeTrailingSlash:=True)''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' append FolderName to the full folder fnameTempFolderName = TempFolderName & FileName''''''''''''''''''''''''''''''''''''''''' Create the folder is requested.''''''''''''''''''''''''''''''''''''''''If Create = True ThenOn Error Resume NextErr.ClearMkDir TempFolderNameIf Err.Number <> 0 ThenMsgBox "An error occurred creating folder '" & TempFolderName & _"'" & vbCrLf & _"Err: " & CStr(Err.Number) & vbCrLf & _"Description: " & Err.DescriptionGetTemporaryFolderName = vbNullStringExit FunctionEnd IfEnd If''''''''''''''''''''''''''''''''''''''''' return the result''''''''''''''''''''''''''''''''''''''''GetTemporaryFolderName = TempFolderNameEnd Function
GetTempFile
Public Function GetTempFile (Optional InFolder As String = vbNullString, _Optional FileNamePrefix As String = vbNullString, _Optional Extension As String = vbNullString, _Optional CreateFile As Boolean = True)''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' GetTempFileName' This function will return the name of a temporary file, optionally suffixed with the' string in the Extension variable. It will optionally create the file.'' If InFolder specifies an existing folder, the file will be created in that folder.' If InFolder specifies a non-existant folder, the procedure will attempt to create' the folder.' If InFolder is vbNullString, the procedure will call GetTempFolderName to get' the folder designated for temporary files.' InFolder must be a fully qualified path. That is, a folder name begining with a' network prefix "\\" or containing ":".' If FileNamePrefix is specified, the file name will begin with the first three' characters of this string. In this case, FileNamePrefix must be three characters' with no spaces or illegal file name characters. These are validated with' PathGetCharType. If FileNamePrefix is vbNullString, the value of C_DEFAULT_PREFIX' will be used.' If FileNamePrefix contains spaces or invalid characters, an error occurs.'' If Extension is specified, the filename will have that Extension. If must be three' valid characters (no spaces). The characters are validated with PathGetCharType.' If Extension is vbNullString the default extension from GetTempFileName ("tmp") is' used. Do NOT put the period in front of the extension (e.g., use "xls" not ".xls").' If Extension is a single space, the file name will have no extension.'' If CreateFile is omitted or True, the file will be created. If CreateFile is false,' the file is not created. (Actually, it will be created by GetTempFileName and then' KILLed.)'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Dim PathBuffer As StringDim Prefix As StringDim FolderPath As StringDim Res As LongDim FileName As StringDim ErrorNumber As LongDim ErrorText As StringDim FileNumber As IntegerConst C_DEFAULT_PREFIX = "TMP"FileName = String$(MAX_PATH, vbNullChar)If InFolder = vbNullString Then'''''''''''''''''''''''''''''''''''''''''''''''''''''''''' InFolder was an empty string. Call GetTempFolderName' to get a temporary folder name.'''''''''''''''''''''''''''''''''''''''''''''''''''''''''PathBuffer = GetTempFolderName(IncludeTrailingSlash:=True)Else'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' test to see if we have an absolute path'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''If (Left(InFolder, 2) = "\\") Or _(InStr(1, InFolder, ":", vbTextCompare) > 0) Then'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' We have an absolute path. Test whether the folder exists.'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''If Dir(InFolder, vbHidden + vbSystem + vbHidden + _vbNormal + vbDirectory) = vbNullString Then'''''''''''''''''''''''''''''''''''''''''''''''''''' InFolder does not exist. Try to create it.'''''''''''''''''''''''''''''''''''''''''''''''''''On Error Resume NextErr.ClearMkDir InFolderIf Err.Number <> 0 ThenMsgBox "An error occurred creating the '" & InFolder _& "' folder." & vbCrLf & _"Error: " & CStr(Err.Number) & vbCrLf & _"Description: " & Err.Description, vbOKOnly, "GetTempFileName"GetTempFile = vbNullStringExit FunctionElse'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' MkDir succussfully created the folder. Set PathBuffer to the new' folder name.'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''PathBuffer = InFolderEnd IfElse'''''''''''''''''''''''''''''''''''''''''''''''''''' InFolder exists. Set the PathBuffer variable to InFolder'''''''''''''''''''''''''''''''''''''''''''''''''''PathBuffer = InFolderEnd IfElse''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' We don't have a fully qualified path. Get out with an error message.''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''MsgBox "The InFolder parameter to GetTempFile is not an absolute file name.", _vbOKOnly, "GetTempFileName"GetTempFile = vbNullStringExit FunctionEnd If ' LEFTEnd If ' InFolder = vbNullString''''''''''''''''''''''''''''''''''''''''''' Ensure we have a '\' at the end of the' path.'''''''''''''''''''''''''''''''''''''''''If Right(PathBuffer, 1) <> "\" ThenPathBuffer = PathBuffer & "\"End IfIf FileNamePrefix = vbNullString Then'''''''''''''''''''''''''''''''''''''''''' FileNamePrefix is empty, use 'tmp''''''''''''''''''''''''''''''''''''''''''Prefix = C_DEFAULT_PREFIXElseIf IsValidFileNamePrefixOrExtension(Spec:=FileNamePrefix) = False Then'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' FileNamePrefix is invalid. Get out with an error.'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''MsgBox "The file name prefix '" & FileNamePrefix & "' is invalid.", _vbOKOnly, "GetTempFileName"GetTempFile = vbNullStringExit FunctionElse'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' FileNamePrefix is valid.'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Prefix = FileNamePrefixEnd IfEnd If''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Get the temp file name. GetTempFileName will automatically' create the file. If CreateFile is False, we'll have' to Kill the file. We set wUnique to 0 to ensure that' the filename will be unique. This has the side effect' of creating the file.''''''''''''''''''''''''''''''''''''''''''''''''''''''''Res = GetTempFileName(lpszPath:=PathBuffer, _lpPrefixString:=Prefix, _wUnique:=0, _lpTempFileName:=FileName)If Res = 0 Then''''''''''''''''''''''''''''' An error occurred. Get out' with an error message.''''''''''''''''''''''''''''ErrorNumber = Err.LastDllErrorErrorText = GetSystemErrorMessageText(ErrorNumber)MsgBox "An error occurred with GetTempFileName" & vbCrLf & _"Error: " & CStr(ErrorNumber) & vbCrLf & _"Description: " & ErrorText, vbOKOnly, "GetTempFileName"GetTempFile = vbNullStringExit FunctionEnd If''''''''''''''''''''''''''''''''''''''''''' GetTempFileName put the file name in the' FileName variable, ending with a vbNullChar.' Trim to the the vbNullChar.'''''''''''''''''''''''''''''''''''''''''''FileName = TrimToNull(Text:=FileName)'''''''''''''''''''''''''''''''''''''''''''' GetTempFileName created a file with an' extension of "tmp". If Extension was' specified and is not a null string,' change the extension to the specified' extension. We'll use the same validation' routine as we did for the prefix.'''''''''''''''''''''''''''''''''''''''''''If Extension = vbNullString Then'''''''''''''''''''''''''''''''''''''''''''''''''''''''' If Extension is vbNullString, use the extension' created by GetTEmpFileName ("tmp"). Test whether' CreateFile is False. If False, we have to kill the' newly created file.'''''''''''''''''''''''''''''''''''''''''''''''''''''''If CreateFile = False ThenOn Error Resume NextKill FileNameElse''''''''''''''''''''''''''''''''''' CreateFile was true. Leave' the newly created file in place''''''''''''''''''''''''''''''''''End IfElse ' Extension is not vbNullStringIf Extension = " " Then''''''''''''''''''''''''''''''''''''' An Extension value of " " indicates' that the filename should have no' extension. First Kill FileName, modify' the variable to have no extension, and then' see if we need to create the file. If CreateFile' if False, don't create the file. If True,' create the file by openning it and then' immmediately close it.''''''''''''''''''''''''''''''''''''On Error Resume NextKill FileNameOn Error GoTo 0FileName = Left(FileName, Len(FileName) - 4)If CreateFile = True Then''''''''''''''''''''''''''''''''''''''''' Create the file by opening it for' output, then immediately closing it.''''''''''''''''''''''''''''''''''''''''FileNumber = FreeFileOpen FileName For Output Access Write As #FileNumberClose #FileNumberElse'''''''''''''''''''''''''''''''''''''''''' CreateFile was false. Since we've already' Killed the file created by GetTempFileName,' do nothing.''''''''''''''''''''''''''''''''''''''''''End IfElseIf IsValidFileNamePrefixOrExtension(Spec:=Extension) Then''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' If we have a valid extension, kill the existing filename' and the recreate the file with the new extension.''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''On Error Resume NextKill FileNameOn Error GoTo 0FileName = Left(FileName, Len(FileName) - 4) & "." & ExtensionIf CreateFile = True ThenFileNumber = FreeFileOpen FileName For Output Access Write As #FileNumberClose #FileNumberElse''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' CreateFile was false. Since we've already killed the' filename created by GetTempFileName, do nothing.''''''''''''''''''''''''''''''''''''''''''''''''''''''''''End IfElse''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' The extension was not valid. Display an error and get out.''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''MsgBox "The extension '" & Extension & "' is not valid.", _vbOKOnly, "GetTempFileName"GetTempFile = vbNullStringExit FunctionEnd IfEnd IfEnd If''''''''''''''''''''''''''''''''''''''''''''' We were successful. Return the filename.''''''''''''''''''''''''''''''''''''''''''''GetTempFile = FileNameEnd FunctionPrivate Function IsValidFileNamePrefixOrExtension(Spec As String) As Boolean'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' IsValidFileNamePrefix' This returns TRUE if Prefix is a valid 3 character filename' prefix used with GetTempFileName'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Const GCT_INVALID As Long = &H0Const GCT_SEPARATOR As Long = &H8Const GCT_WILD As Long = &H4Const GCT_LFNCHAR As Long = &H1Const GCT_SHORTCHAR As Long = &H2Dim Ndx As LongDim B As Byte'''''''''''''''''''''''''''''''''' prefix contains a space. error.'''''''''''''''''''''''''''''''''If InStr(1, Spec, " ") > 0 ThenIsValidFileNamePrefixOrExtension = FalseExit FunctionEnd If'''''''''''''''''''''''''''''''''' prefix is not 3 chars. error.'''''''''''''''''''''''''''''''''If Len(Spec) <> 3 ThenIsValidFileNamePrefixOrExtension = FalseExit FunctionEnd If'''''''''''''''''''''''''''''''''' Loop through the 3 characters' of Prefix. If we find an' invalid character, get out with' a result of False.'''''''''''''''''''''''''''''''''For Ndx = 1 To 3B = CByte(Asc(Mid(Spec, Ndx, 1)))Select Case PathGetCharType(B)Case GCT_INVALID, GCT_SEPARATOR, GCT_WILDIsValidFileNamePrefixOrExtension = FalseExit FunctionCase GCT_LFNCHAR, GCT_SHORTCHAR, GCT_LFNCHAR + GCT_SHORTCHARCase ElseIsValidFileNamePrefixOrExtension = FalseExit FunctionEnd SelectNext Ndx'''''''''''''''''''''''''''''''''' If we made it out of the loop,' the Prefix was valid. Return' True.'''''''''''''''''''''''''''''''''IsValidFileNamePrefixOrExtension = TrueEnd FunctionPublic Function TrimToNull(S As String) As String''''''''''''''''''''''''''''''''''''''''''''''''''''' TrimToNull' This returns the portion of the string S that' is to the left of the first vbNullChar character.' If vbNullChar is not found, the entire string is' returned.''''''''''''''''''''''''''''''''''''''''''''''''''''Dim Pos As IntegerPos = InStr(1, S, vbNullChar)If Pos > 0 ThenTrimToNull = Left(S, Pos - 1)ElseTrimToNull = SEnd IfEnd Function
Nenhum comentário:
Postar um comentário