AboutManish Batola Expertise ALL MICROSOFT ACCESS DESIGN AND Development QUESTIONS which occur in a Access Projects Lifecycle. Can offer constructive help on Designing Advanced MS-ACCESS Applications such CRM/FRM(Follow-up),Chemicals Indenting,Import/Export,MRP - Manufacturing Resource Planning, ERP - Enterprise Resource Planning, Automotive Management Systems, Business Intelligence for Oil & Gas Drilling Operations, CRM,KPI- Key Performance Indicators,HealthCare, Hospitality, Constructions, Loyalty Clubs, Call Centers, Travel & Tourism, Educational Institutions and many more being added every year.
Experience 25 yrs in the Software industry with 19yrs completely dedicated on more than 250 Various Access Projects from different Industry Sector[s]. I'm using Access ever since it was born.
Organizations Worked in various multinationals catering from Aerospace, Oil & Gas etc.
I would like to give my users the possibility to drag and drop files into a list box on my "Attachments" form in the formats: word, xls, and even pdf if possible.
I have gathered codes from the web, but they either
1)
yield:
"453 Error
Can't find DLL entry point EbGetExecutingProj in VBE6.DLL"
Code:
Private Declare Function GetCurrentVbaProject _
Lib "VBE6.DLL" Alias "EbGetExecutingProj" _
(hProject As Long) As Long
Private Declare Function GetFuncID _
Lib "VBE6.DLL" Alias "TipGetFunctionId" _
(ByVal hProject As Long, ByVal strFunctionName As String, _
ByRef strFunctionId As String) As Long
Private Declare Function GetAddr _
Lib "VBE6.DLL" Alias "TipGetLpfnOfFunctionId" _
(ByVal hProject As Long, ByVal strFunctionId As String, _
ByRef lpfn As Long) As Long
'******** Code Start ********
Private Declare Function apiCallWindowProc Lib "user32" _
Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc As Long, _
ByVal Hwnd As Long, _
ByVal Msg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) _
As Long
Private Declare Function apiSetWindowLong Lib "user32" _
Alias "SetWindowLongA" _
(ByVal Hwnd As Long, _
ByVal nIndex As Long, _
ByVal wNewWord As Long) _
As Long
Private Declare Function apiGetWindowLong Lib "user32" _
Alias "GetWindowLongA" _
(ByVal Hwnd As Long, _
ByVal nIndex As Long) _
As Long
Private Declare Sub sapiDragAcceptFiles Lib "shell32.dll" _
Alias "DragAcceptFiles" _
(ByVal Hwnd As Long, _
ByVal fAccept As Long)
Private Declare Sub sapiDragFinish Lib "shell32.dll" _
Alias "DragFinish" _
(ByVal hDrop As Long)
Private Declare Function apiDragQueryFile Lib "shell32.dll" _
Alias "DragQueryFileA" _
(ByVal hDrop As Long, _
ByVal iFile As Long, _
ByVal lpszFile As String, _
ByVal cch As Long) _
As Long
Private lpPrevWndProc As Long
Private Const GWL_WNDPROC As Long = (-4)
Private Const GWL_EXSTYLE = (-20)
Private Const WM_DROPFILES = &H233
Private Const WS_EX_ACCEPTFILES = &H10&
Private hWnd_Frm As Long
Sub sDragDrop(ByVal Hwnd As Long, _
ByVal Msg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long)
Dim lngRet As Long, strTmp As String, intLen As Integer
Dim lngCount As Long, i As Long, strOut As String
Const cMAX_SIZE = 50
On Error Resume Next
If Msg = WM_DROPFILES Then
strTmp = String$(255, 0)
lngCount = apiDragQueryFile(wParam, &HFFFFFFFF, strTmp, Len(strTmp))
For i = 0 To lngCount - 1
strTmp = String$(cMAX_SIZE, 0)
intLen = apiDragQueryFile(wParam, i, strTmp, cMAX_SIZE)
strOut = strOut & Left$(strTmp, intLen) & ";"
Next i
strOut = Left$(strOut, Len(strOut) - 1)
Call sapiDragFinish(wParam)
With Forms!frmDragDrop!lstDrop
.RowSourceType = "Value List"
.RowSource = strOut
Forms!frmDragDrop.Caption = "DragDrop: " & _
.ListCount & _
" files dropped."
End With
Else
lngRet = apiCallWindowProc( _
ByVal lpPrevWndProc, _
ByVal Hwnd, _
ByVal Msg, _
ByVal wParam, _
ByVal lParam)
End If
End Sub
Sub sEnableDrop(frm As Form)
Dim lngStyle As Long, lngRet As Long
lngStyle = apiGetWindowLong(frm.Hwnd, GWL_EXSTYLE)
lngStyle = lngStyle Or WS_EX_ACCEPTFILES
lngRet = apiSetWindowLong(frm.Hwnd, GWL_EXSTYLE, lngStyle)
Call sapiDragAcceptFiles(frm.Hwnd, True)
hWnd_Frm = frm.Hwnd
End Sub
Public Function AddrOf(strFuncName As String) As Long
'-------------------------------------------------------------------------------------------------------------------
' AddrOf
'
' Returns a function pointer of a VBA public function given its name. This function
' gives similar functionality to VBA as VB5 has with the AddressOf param type.
'
' NOTE: This function only seems to work if the proc you are trying to get a pointer
' to is in the current project. This makes sense, since we are using a function
' named EbGetExecutingProj.
'-------------------------------------------------------------------------------------------------------------------
Dim hProject As Long
Dim lngResult As Long
Dim strID As String
Dim lpfn As Long
Dim strFuncNameUnicode As String
Const NO_ERROR = 0
' The function name must be in Unicode, so convert it.
strFuncNameUnicode = StrConv(strFuncName, vbUnicode)
' Get the current VBA project
' The results of GetCurrentVBAProject seemed inconsistent, in our tests,
' so now we just check the project handle when the function returns.
Call GetCurrentVbaProject(hProject)
' Make sure we got a project handle... we always should, but you never know!
If hProject <> 0 Then
' Get the VBA function ID (whatever that is!)
lngResult = GetFuncID(hProject, strFuncNameUnicode, strID)
' We have to check this because we GPF if we try to get a function pointer
' of a non-existent function.
If lngResult = NO_ERROR Then
' Get the function pointer.
lngResult = GetAddr(hProject, strID, lpfn)
If lngResult = NO_ERROR Then
AddrOf = lpfn
End If
End If
End If
End Function
'============== End of (mdlAddOf) ===================================
Sub sHook(Hwnd As Long, _
strFunction As String)
lpPrevWndProc = apiSetWindowLong(Hwnd, _
GWL_WNDPROC, _
AddrOf(strFunction))
End Sub
Private Sub Form_Open(Cancel As Integer)
Call sEnableDrop(Me)
Call sHook(Me.Hwnd, "sDragDrop")
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call sUnhook(Me.Hwnd)
End Sub
'******** Code End ********
I do not understand modules, and OLE objects to write my own code.
If you could enlight me on this, it would be greatky appreciated.
Thanks
Soph
ANSWER: Hi Sophie,
Just to remind you this function is purely a Visual Basic function and this part of the site supports VBA for Microsoft Access User's not Visual Basic Development or Windows Development.
Anyway what I would like to know is the following:
1-You need users to drag & drop files as an attachment, is this for an OUTLOOK attachment ? If yes, I can give you the code. Or else you may need to look for support in the Windows or Visual Basic support site.
2-Why do u want to drag & drop a list of files into a list box, when a list box can already have them displayed for you ?
Pls let me know which area you're looking for support.
Best regards,
Manish Batola.
---------- FOLLOW-UP ----------
QUESTION: Hey Manish, thx for getting back so fast,
I do understand this is a visual basic function, but I do not understand the details of that code at all.
I have noticed there are functions called within that code which bug my access, but it should almost work in theory.
1- This not for OUTLOOK attachments unfortunately, but drag and drops from windows explorer/lotus notes (primitive..)
2-That's exactly what I thought: The users using the database would be disciplined, and always save their db related files into the same folder, so the only code required is to display in a list box a path for the attachments, which will be open on an OnClick event.
but: I have been specifically asked to create the such:
-users have to be able to drag and drop from windows explorer pdf/xls/word files onto a form of the database, such that the files are saved directly (!!) into the database.
( I bet they expect to see icons as well...! mmh.)
They told me they had seen it before...have you?
Do you reckon that is doable?
Regards,
Soph
ANSWER: Hi Sophie,
Are these user's of your's real technical people, or else to cover up you can camouflage the entire situation. You can show a drag and drop of a file but only let the file path get stored in the table, and let an icon be displayed instead of the actual file path.
My advice to your user's is that storing an attachment in an access table or backend is not a good idea. This will bloat your data base size like crazy.
Regarding the code I don't deal with Windows API code which you have provided. But you may need to make changes in your development.
Let me know, till then let me think what we can do.
Best regards,
Manish Batola
---------- FOLLOW-UP ----------
QUESTION: Hey Manish,
Precisions:
- No, these users are not at all real technical people
- drag and drop to get a path dipslayed as an icon is a very good compromise for (very) non technical users
How is the information of the icon image passed on?
Is it stored as a jpeg into the computer (if so, I cannot find its path having restriected admin rights..), and which should then be displayed as an image onto an access's form?
Thanks,
Soph
Answer Hi Sophie,
I have a .mdb file reqarding Access Drag n Drop in my office computer. I hope its still there, I will go to office tommorrow and search for it. If found I will email it to you as an attachment.
Please send me the email where u want me have it sent. Keeping my fingers crossed that it should be there in the location I last saw it.
That .mdb file consist of a complete Drag and drop facility which I think u can directly copy. Its based on the Northwind sample database.
