Hallo, ich benutze in meinen Programmen seit über 20 Jahren die Api fGetLongName von Dev Ashis.
Erstaunlicherweise läuft das alles immer noch einwandfrei mit der Runtimeversion von Access 97.
Dennoch hätte ich das gerne mal hochkonvertiert auf Access 2007, damit ich die Runtime von 97 beim Kunden nicht mehr installieren muss.
Die Api bleibt natürlich hängen bei Type WIN32_FIND_DATA mit "interner Fehler". Was muss ich ändern um in die 64 Bit Version umzuschreiben? Das mit den LongPtr-Datentypen habe ich nicht kapiert. Muss ich das überhaupt umschreiben oder gibt es eine andere Lösung?
Und welche Dateien muss ich im meine Setupdatei einbinden um die Runtime von Access 2007 laufen zu lassen?
Gruß Marie
'************ Code Start **********
Option Compare Database
Option Explicit
'Usage Examples:
'?fGetLongName("D:\INTERN~1.0SE\THISFO~1.TXT")
'D:\Internet Explorer 4.0 Setup\This folder is safe to delete.txt
'
'?fGetLongName(currentdb.Name)
'C:\Program Files\Microsoft Office\Office\Samples\Solutions.mdb
'
'?fGetLongName("C:\PROGRA~1\MICROS~2\Office\Samples\Northwind.mdb")
'C:\Program Files\Microsoft Office\Office\Samples\Northwind.mdb
Private Const MAX_PATH& = 260
Private Const INVALID_HANDLE_VALUE = -1
Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Type WIN32_FIND_DATA ' 318 Bytes
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved¯ As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Private Declare Function apiFindFirstFile Lib "kernel32" _
Alias "FindFirstFileA" _
(ByVal lpFileName As String, _
lpFindFileData As WIN32_FIND_DATA) _
As Long
Private Declare Function apiFindClose Lib "kernel32" _
Alias "FindClose" _
(ByVal hFindFile As Long) _
As Long
Function fGetLongName(ByVal strFileName As String) As String
Dim lpFindFileData As WIN32_FIND_DATA
Dim strPath As String, lngRet As Long
Dim strFile As String, lngX As Long, lngY As Long
Dim strTmp As String
strTmp = ""
Do While Not lngRet = INVALID_HANDLE_VALUE
lngRet = apiFindFirstFile(strFileName, lpFindFileData)
strFile = Left$(lpFindFileData.cFileName, _
InStr(lpFindFileData.cFileName, _
vbNullChar) - 1)
If Len(strFileName) > 2 Then
strTmp = strFile & "\" & strTmp
strFileName = fParseDir(strFileName)
Else
strTmp = strFileName & "\" & strTmp
Exit Do
End If
Loop
fGetLongName = Left$(strTmp, Len(strTmp) - 1)
lngY = apiFindClose(lngRet)
End Function
Function fParseDir(strInFile As String) As String
Dim intLen As Long, boolFound As Boolean
Dim i As Integer, f As String, strDir As String
intLen = Len(strInFile)
If intLen > 0 Then
boolFound = False
For i = intLen To 1 Step -1
If Mid$(strInFile, i, 1) = "\" Then
f = Mid$(strInFile, i + 1)
strDir = Left$(strInFile, i - 1)
boolFound = True
Exit For
End If
Next i
End If
If boolFound Then
fParseDir = strDir
Else
fParseDir = strInFile
End If
End Function
'************ Code Ende **********