OBTER NOME DO TIPO DE ARQUIVO

JANDER 15/12/2010 08:50:55
#359584 Resposta escolhida

ve se é isso que vc precisa.

a = NomeDoArquivo([Ô]C:    exto.txt[Ô])

Function NomeDoArquivo(Arquivo As String)

Nome = Mid(Arquivo, 1, InStr(Arquivo, [Ô].[Ô]) - 1)

Do Until InStr(Nome, [Ô]\[Ô]) = 0
Nome = Mid(Nome, InStr(Nome, [Ô]\[Ô]) + 1)
Loop

NomeDoArquivo = Nome

End Function

LIGABUE 15/12/2010 21:28:09
#359640

Obrigado pelo help Jader e RCabrera.

Depois que postei a minha dúvida ontem acabei achando a resposta em um site, segue abaixo caso interessar a alguem do forum ( deve-se adaptar algumas linhas de código e vai funfar beleza!)

[ô]************
[ô]***** MÒDULO
[ô]************


Option Explicit
Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const ERROR_SUCCESS = 0&
Private Const REG_SZ = 1


Private Declare Function RegOpenKey Lib [Ô]advapi32.dll[Ô] Alias [Ô]RegOpenKeyA[Ô] (ByVal hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long


Private Declare Function RegQueryValueEx Lib [Ô]advapi32.dll[Ô] Alias [Ô]RegQueryValueExA[Ô] (ByVal hkey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long


Private Declare Function RegCloseKey Lib [Ô]advapi32.dll[Ô] (ByVal hkey As Long) As Long

Public Function GetSettingString(hkey As Long, strPath As String, strValue As String, Optional Default As String) As String
[ô]Function to query the Windows Registry
[ô] (taken from the standard collection of f
[ô] unctions we all know and love)
Dim hCurKey As Long, lResult As Long, lValueType As Long, strBuffer As String
Dim lDataBufferSize As Long, intZeroPos As Integer, lRegResult As Long

If Not IsEmpty(Default) Then GetSettingString = Default Else GetSettingString = [Ô][Ô]
lRegResult = RegOpenKey(hkey, strPath, hCurKey)
lRegResult = RegQueryValueEx(hCurKey, strValue, 0&, lValueType, ByVal 0&, lDataBufferSize)


If lRegResult = ERROR_SUCCESS Then


If lValueType = REG_SZ Then
strBuffer = String(lDataBufferSize, [Ô] [Ô])
lResult = RegQueryValueEx(hCurKey, strValue, 0&, 0&, ByVal strBuffer, lDataBufferSize)
intZeroPos = InStr(strBuffer, Chr$(0))


If intZeroPos > 0 Then
GetSettingString = Left$(strBuffer, intZeroPos - 1)
Else
GetSettingString = strBuffer
End If
End If
Else
[ô] there is a problem
End If

lRegResult = RegCloseKey(hCurKey)
End Function


Function FileType(Filename As String) As String
[ô]Queries the Registry to return the file


[ô] type
Dim strExt As String, strKey As String, strType As String
strExt = [Ô].[Ô] & Extension(Filename) [ô] essa função não tenho mas pode usar o mid por exemplo para se retirar a extensão de um arquivo
[ô]Find out the handler for that particula
[ô] r type of file
strKey = GetSettingString(HKEY_CLASSES_ROOT, strExt, [Ô][Ô])
[ô]Find out what the file[ô]s handler calls
[ô] this type of file
strType = GetSettingString(HKEY_CLASSES_ROOT, strKey, [Ô][Ô])

FileType = strType
End Function


[ô]***********
[ô]****EXEMPLO
[ô]***********

[ô]Msgbox Filetype([Ô]c:\autoexec.bat[Ô])

-------------------------------------------------------
espero que ajude alguem com me ajudou, valeu e abraços!!!