Posts by [email protected]

PrivateDeclareSub mouse_event Lib"user32"(ByVal dwFlags AsLong, _
ByVal dx AsLong, _
ByVal dy AsLong, _
ByVal cbuttons AsLong, _
ByVal dwExtraInfo AsLong)


PrivateConst MOUSEEVENTF_MOVE =&H1' mouse move
PrivateConst MOUSEEVENTF_LEFTDOWN =&H2' left button down
PrivateConst MOUSEEVENTF_LEFTUP =&H4' left button up
PrivateConst MOUSEEVENTF_RIGHTDOWN =&H8' right button down
PrivateConst MOUSEEVENTF_RIGHTUP =&H10' right button up


PrivateConst MOUSEEVENTF_ABSOLUTE =&H8000' absolute move


Sub LeftClick(X AsLong, Y AsLong)
'Move mouse
mouse_event MOUSEEVENTF_MOVE, X, Y,0,0


'Press left click
mouse_event MOUSEEVENTF_LEFTDOWN,0,0,0,0


'Release left click
mouse_event MOUSEEVENTF_LEFTUP,0,0,0,0
EndSub


PrivateSub UploadFile()


Dim IE As InternetExplorerMedium
Set IE =New InternetExplorerMedium


With IE
.Visible =True
' Send the form data To URL As POST binary request
.navigate "URL"


' Wait while IE loading...
While.Busy Or.ReadyState <>4
Application.Wait (Now()+ TimeValue("00:00:01"))
DoEvents
Wend


EndWith




Dim X AsLong
Dim Y AsLong
X =20
Y =120


LeftClick X, Y


Set IE =Nothing
Set objElement =Nothing


EndSub

Option Explicit




Const FOLDER_PATH = "C:\Temp\"  'REMEMBER END BACKSLASH




Sub ImportWorksheets()
   '=============================================
   'Process all Excel files in specified folder
   '=============================================
   Dim sFile As String           'file to process
   Dim wsTarget As Worksheet
   Dim wbSource As Workbook
   Dim wsSource As Worksheet
   
   Dim rowTarget As Long         'output row
   
   rowTarget = 2
   
   'check the folder exists
   If Not FileFolderExists(FOLDER_PATH) Then
      MsgBox "Specified folder does not exist, exiting!"
      Exit Sub
   End If
   
   'reset application settings in event of error
   On Error GoTo errHandler
   Application.ScreenUpdating = False
   
   'set up the target worksheet
   Set wsTarget = Sheets("Sheet2")
   
   'loop through the Excel files in the folder
   sFile = Dir(FOLDER_PATH & "*.xls*")
   Do Until sFile = ""
      
      'open the source file and set the source worksheet - ASSUMED WORKSHEET(1)
      Set wbSource = Workbooks.Open(FOLDER_PATH & sFile)
      Set wsSource = Sheets("DispForm") 'EDIT IF NECESSARY
      
      'import the data
      With wsTarget
         .Range("A" & rowTarget).Value = wsSource.Range("J3").Value
        
         .Range("B" & rowTarget).Value = wsSource.Range("B9").Value
         .Range("C" & rowTarget).Value = wsSource.Range("C9").Value
         
         'optional source filename in the last column
         .Range("D" & rowTarget).Value = sFile
      End With
      
      'close the source workbook, increment the output row and get the next file
      wbSource.Close SaveChanges:=False
      rowTarget = rowTarget + 1
      sFile = Dir()
   Loop
   
errHandler:
   On Error Resume Next
   Application.ScreenUpdating = True
   
   'tidy up
   Set wsSource = Nothing
   Set wbSource = Nothing
   Set wsTarget = Nothing
End Sub








Private Function FileFolderExists(strPath As String) As Boolean
    If Not Dir(strPath, vbDirectory) = vbNullString Then FileFolderExists = True
End Function