Open Wildcard File in Internet Explorer from Folders and Close IE VBA

Video:

Code:


Sub FolderAndFileMacro()



Dim mypath As String
Dim myfile As String
Dim myfile2
Dim myextension As String
Dim wb As Workbook
Dim FldrPicker As FileDialog


Dim xx As Double

 Dim oFSO As Object
 Dim folder As Object
 Dim subfolders As Object
 
 Set oFSO = CreateObject("Scripting.FileSystemObject")
 Set folder = oFSO.GetFolder("C:\Users\18622\OneDrive\Desktop\auto-read\")
 Set subfolders = folder.subfolders
 xx = subfolders.Count
 
 Set oFSO = Nothing
 Set folder = Nothing
 Set subfolders = Nothing
 'release memory

Dim X As Double

X = 1

Do Until X > xx






mypath = "C:\Users\18622\OneDrive\Desktop\auto-read\" & X & "\"

'pull file names from Module 2 called GrabFilenamesfromFolder. It pulls the file names from the folder you select and set to mypath variable.
GrabFilenamesfromFolder (mypath)


erow = Range("A" & Rows.Count).End(xlUp).Row
Range("B1").Select
ActiveCell.FormulaR1C1 = "=SEARCH(""*5*.pdf"",RC[-1],1)"
Range("B1").Select
Selection.AutoFill Destination:=Range("B1" & ":" & "B" & erow), Type:=xlFillDefault
Columns("B").Select
Selection.Copy
Columns("B").Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=False
 Columns("B").Select

 Selection.Replace What:="#VALUE!", Replacement:="0", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
Dim counter As Double
counter = 1
      


'Target File Extension (must include wildcard "*")


'Loop through each Excel file in folder
Do Until counter > erow
line15:
If Range("B" & counter).Value <> 0 Then
myfile2 = Range("A" & counter).Value
counter = counter + 1
GoTo line11:
End If
counter = counter + 1
Loop
line11:
'Set variable equal to opened workbook


Dim objIE As Object
  
  
Dim nextrow As Integer

If myfile2 = "" Then
GoTo line33:
End If

Set objIE = CreateObject("InternetExplorer.Application")





  With objIE
   .Top = 0
    .Left = 0
.Height = 1000
.Width = 1000
    .Navigate mypath & myfile2

  End With
  

'Call Shell("TaskKill /F /PID " & CStr(objIE), vbHide)



 Dim objWMI As Object, objProcess As Object, objProcesses As Object
    Set objWMI = GetObject("winmgmts://.")
    Set objProcesses = objWMI.ExecQuery( _
        "SELECT * FROM Win32_Process WHERE Name = 'iexplore.exe'")
    For Each objProcess In objProcesses
        Call objProcess.Terminate
        On Error GoTo ErrorHandler

    Next
    
ErrorHandler:
    Set objProcesses = Nothing: Set objWMI = Nothing


 'add actions to do to this workbook
      
'switch back to workbook that has this macro
Workbooks("PDF SCREENS.xlsm").Activate
'close myfile


Range("P" & X).Value = InputBox("What category is it?")

line33:

Workbooks("PDF SCREENS.xlsm").Activate
Columns("A:B").Select
Selection.ClearContents
X = X + 1
Loop

End Sub

Sub GrabFilenamesfromFolder(path As String)
    Dim currentPath As String, directory As Variant
    Dim dirCollection As Collection
    Set dirCollection = New Collection
    Dim counter As Double
    counter = 1
    currentPath = Dir(path, vbDirectory)
    
    'Explore current directory
    Do Until currentPath = vbNullString
        Debug.Print currentPath
        'If Left(currentPath, 1) <> "." And _
            '(GetAttr(path & currentPath) And vbDirectory) = vbDirectory Then
            dirCollection.Add currentPath
        'End If
        currentPath = Dir()
        Range("A" & counter).Value = currentPath
        counter = counter + 1
    Loop
    
   
End Sub

Comments are closed.