Private Const DCOM_DLL_PATH_NAME As String _
= "C:\WINDOWS\system32\DirectCOM.dll" 'NOT USED
Private Const JAAFAR_DLL_PATH_NAME As String _
= "C:\WINDOWS\system32\DragAndDropWatcher.dll" 'NOT USED
'CreateObject-Replacement (FileBased)
Private Declare Function GETINSTANCE Lib "DirectCom" _
(FName As String, ClassName As String) As Object
Private Declare Function UNLOADCOMDLL Lib "DirectCom" _
(FName As String, ClassName As String) As Long
Private oDragAndDropInstance As Object
Private DLLfolder As String
'=================================================================
'Drag and Drop custom event.
'Event Procedure Must be PUBLIC !!! and located in the workbook module.
'Use the ByRef Cancel argument to prevent the drop operation.
Public Sub OnCellDrop _
(ByVal Source As Range, ByVal Target As Range, ByRef Cancel As Boolean)
MsgBox "You are trying to drag the Range : " & Source.Address & _
vbNewLine & " onto the Range : " & Target.Address & vbNewLine _
& vbNewLine & "This Action is not permitted.", vbCritical
Cancel = True
End Sub
'=====================================================================
Private Sub Workbook_Open()
DLLfolder = ThisWorkbook.Path & "\"
'Create the DirectCom & DragAndDropWatcher dlls.
CreateDlls DLLfolder
ChDir DLLfolder
'load an instance of the 'DragAndDropWatcher.dll' Class.
Set oDragAndDropInstance = _
GETINSTANCE(DLLfolder & "DragAndDropWatcher.dll", "DragAndDropClass")
'GETINSTANCE(JAAFAR_DLL_PATH_NAME, "DragAndDropClass")
DoEvents
If Not oDragAndDropInstance Is Nothing Then
'start watching the Drop and Drag operations.
Call oDragAndDropInstance.Start(ThisWorkbook)
Else
MsgBox "Unable to load the " & _
"'DragAndDropWatcher' dll.", vbInformation
End If
''
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Not oDragAndDropInstance Is Nothing Then
oDragAndDropInstance.Finish
Set oDragAndDropInstance = Nothing
End If
'UNLOADCOMDLL JAAFAR_DLL_PATH_NAME, "DragAndDropClass"
UNLOADCOMDLL DLLfolder & "DragAndDropWatcher.dll", "DragAndDropClass"
End Sub
'Create the 'DragAndDropWatcher' dll and DirectCom.dll from the
'Bytes stored in the '"DllBytes" hidden worksheet.
Private Sub CreateDlls(folderPath As String)
Dim Bytes() As Byte
Dim lFileNum As Integer
Dim aVar
Dim x As Long
Dim dllPath As String
On Error Resume Next
dllPath = folderPath & "DragAndDropWatcher.dll"
'If Len(Dir(DCOM_DLL_PATH_NAME)) = 0 Then 'should be JAAFAR_DLL_PATH_NAME
If Len(Dir(dllPath)) = 0 Then
With Worksheets("DllBytes")
aVar = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)).Value
End With
ReDim Bytes(LBound(aVar) To UBound(aVar))
For x = LBound(aVar) To UBound(aVar)
Bytes(x) = CByte(aVar(x, 1))
Next
lFileNum = FreeFile
'Open JAAFAR_DLL_PATH_NAME For Binary As #lFileNum
Open dllPath For Binary As #lFileNum
Put #lFileNum, 1, Bytes
Close lFileNum
End If
dllPath = folderPath & "\DirectCOM.dll"
'If Len(Dir(DCOM_DLL_PATH_NAME)) = 0 Then
If Len(Dir(dllPath)) = 0 Then
Erase Bytes
With Worksheets("dllBytes")
aVar = .Range(.Cells(1, 2), .Cells(.Rows.Count, 2).End(xlUp)).Value
End With
ReDim Bytes(LBound(aVar) To UBound(aVar))
For x = LBound(aVar) To UBound(aVar)
Bytes(x) = CByte(aVar(x, 1))
Next
lFileNum = FreeFile
'Open DCOM_DLL_PATH_NAME For Binary As #lFileNum
Open dllPath For Binary As #lFileNum
Put #lFileNum, 1, Bytes
Close lFileNum
End If
End Sub
