anyone help me?storing the path...

[az]

hi...anyone can help me???actually...i have a code on vba for storing
path for files into database..but i not really understand what it is
all about...can anyone explain to me...this code is for call path in
database:


Option Compare Database
Option Explicit

Type shellBrowseInfo
hwndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As String
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type

Const BIF_RETURNONLYFSDIRS = 1
Const MAX_PATH = 260

Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Declare Function SHBrowseForFolder Lib "shell32" (lpbi As
shellBrowseInfo) As Long
Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As
Long, _
ByVal lpBuffer As String) As Long

Public Function GetFolder(dlgTitle As String, frmHwnd As Long) As
String

Dim Nullchr As Integer
Dim IDList As Long
Dim Result As Long
Dim Folder As String
Dim BI As shellBrowseInfo

With BI
.hwndOwner = frmHwnd
.lpszTitle = dlgTitle
.ulFlags = BIF_RETURNONLYFSDIRS
End With

IDList = SHBrowseForFolder(BI)
If IDList Then
Folder = String$(MAX_PATH, 0)
Result = SHGetPathFromIDList(IDList, Folder)
Call CoTaskMemFree(IDList) 'this frees the ole pointer
to IDlist
Nullchr = InStr(Folder, vbNullChar)
If Nullchr Then
Folder = Left$(Folder, Nullchr - 1)
End If
End If

GetFolder = Folder

End Function




and this is another one..it is for path of the file(actually i'm not
really sure)

Option Compare Database
Option Explicit

Private Type FileInfo
wLength As Integer
wValueLength As Integer
szKey As String * 16
dwSignature As Long
dwStrucVersion As Long
dwFileVersionMS As Long
dwFileVersionLS As Long
End Type

Private Declare Function GetFileVersionInfo& Lib "Version" _
Alias "GetFileVersionInfoA" _
(ByVal FileName$, ByVal dwHandle&, ByVal cbBuff&, ByVal lpvData$)

Private Declare Function GetFileVersionInfoSize& Lib "Version" _
Alias "GetFileVersionInfoSizeA" _
(ByVal FileName$, dwHandle&)

Private Declare Sub hmemcpy Lib "kernel32" _
Alias "RtlMoveMemory" _
(hpvDest As Any, hpvSource As Any, ByVal cbBytes&)

Dim giMainFolderStrLen As Integer


Const gcMaxSubfolders = 50


Function LOWORD(x As Long) As Integer
On Error Resume Next
LOWORD = x And &HFFFF&
'Low 16 bits contain Minor revision number.
End Function

Function HIWORD(x As Long) As Integer
On Error Resume Next
HIWORD = x \ &HFFFF&
'High 16 bits contain Major revision number.
End Function


Sub ReadFileInfos(strDatabaseName As String, strTblName As String, _
strFolderName As String)

Dim db As Database
Dim rs As Recordset
Dim td As TableDef
Dim fld As Field
Dim idx As Index, fldIndex As Field
Dim fFormat As Property

DoCmd.Hourglass True

giMainFolderStrLen = Len(strFolderName)

If strDatabaseName = "[Current]" Then
Set db = CurrentDb
Else
If Dir(strDatabaseName) = "" Then
Set db = DBEngine.CreateDatabase(strDatabaseName,
dbLangGeneral)
Else
Set db = DBEngine.OpenDatabase(strDatabaseName)
End If
End If

Set td = db.CreateTableDef(strTblName)

Set fld = td.CreateField("IDNum", dbLong)
fld.Attributes = fld.Attributes + dbAutoIncrField
td.Fields.Append fld

Set fld = td.CreateField("FilePath", dbText, 255)
td.Fields.Append fld

Set fld = td.CreateField("FileName", dbText, 255)
td.Fields.Append fld

Set fld = td.CreateField("Version", dbText, 50)
td.Fields.Append fld

Set fld = td.CreateField("FileDate", dbDate)
td.Fields.Append fld

Set fld = td.CreateField("FileLength", dbDouble)
td.Fields.Append fld

Set fld = td.CreateField("Description", dbText, 255)
td.Fields.Append fld


Set idx = td.CreateIndex("PrimaryKey")
Set fldIndex = idx.CreateField("IDNum", dbLong)

idx.Fields.Append fldIndex

idx.Primary = True

td.Indexes.Append idx

db.TableDefs.Append td
db.TableDefs.Refresh

Set rs = db.OpenRecordset(strTblName)

ReadFolderInfo rs, strFolderName & "\"
rs.Close


If strDatabaseName <> "[Current]" Then
db.Close
Else
Set db = Nothing
End If

DoCmd.Hourglass False

End Sub

Sub ReadFolderInfo(rs As Recordset, strFolderName As String)

Dim arrFoldernames(gcMaxSubfolders)
Dim FileName As String
Dim x As FileInfo
Dim FileVer As String
Dim dwHandle&, BufSize&, lpvData$, R&
Dim iLoop As Long, iLoop2 As Long
Dim Types As String

FileName = Dir(strFolderName, vbDirectory)
iLoop = -1

While FileName <> "" And iLoop < gcMaxSubfolders
If FileName <> "." And FileName <> ".." And FileName <> "" Then

If (GetAttr(strFolderName & FileName) And vbDirectory) =
vbDirectory Then
iLoop = iLoop + 1
arrFoldernames(iLoop) = FileName
Else
Types = UCase(Right(FileName, 3))
Select Case Types
Case "xls", "JPG", "PCD", "PCX", "WMF", "EMF", "DIB",
"BMP", "ICO", "EPS", "PCT", "DXF", "CGM", "CDR", "TGA", "GIF", "PNG",
"WPG", "DRW"

FileVer = ""
BufSize& = GetFileVersionInfoSize(strFolderName &
FileName, dwHandle&)
If BufSize& = 0 Then
FileVer = "no Version"
Else
lpvData$ = Space$(BufSize&)
R& = GetFileVersionInfo(strFolderName & FileName,
dwHandle&, BufSize&, lpvData$)
hmemcpy x, ByVal lpvData$, Len(x)


FileVer = Trim$(Str$(HIWORD(x.dwFileVersionMS)))
+ "."
FileVer = FileVer +
Trim$(Str$(LOWORD(x.dwFileVersionMS))) + "."
FileVer = FileVer +
Trim$(Str$(HIWORD(x.dwFileVersionLS))) + "."
FileVer = FileVer +
Trim$(Str$(LOWORD(x.dwFileVersionLS)))
End If
rs.AddNew


rs!FilePath = strFolderName

rs!FileName = FileName
rs!FileLength = FileLen(strFolderName & FileName)
rs!FileDate = FileDateTime(strFolderName & FileName)
rs!Version = FileVer
rs.Update
Case Else
End Select
End If
End If
FileName = Dir
Wend

For iLoop2 = 0 To iLoop
ReadFolderInfo rs, strFolderName & arrFoldernames(iLoop2) & "\"
Next iLoop2

End Sub




Any assitance is appreciated.

Regards