How to find recent excel file in a folder.

Sub Recent_File()

Dim FileName As String
Dim MostRecentFile As String
Dim MostRecentDate As Date

'specify the directory
Directory = "C:\Users\" & Environ("username") & "\Downloads\"
FileName = Dir(Directory & "*.xlsx", 0)
If FileName <> "" Then
    MostRecentFile = FileName
    MostRecentDate = FileDateTime(Directory & FileName)
    Do While FileName <> ""
        If FileDateTime(Directory & FileName) > MostRecentDate Then
             MostRecentFile = FileName
             MostRecentDate = FileDateTime(Directory & FileName)
         End If
         FileName = Dir
    Loop
End If
NewestFile = MostRecentFile
MsgBox "Recent File is " & NewestFile
End Sub

How to copy sheets from one file to another using VBA code

Sub Consolidation_Sheets()
Dim Sheets_Count As Integer
Dim fso As Object
Dim selectedpath As String
Dim strpath As Object
Set fso = CreateObject("scripting.filesystemobject")
fso.createfolder ThisWorkbook.Path & "\Destination"
Workbooks.Add
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\Destination\OutputFile.xlsx"
    With Application.FileDialog(msoFileDialogFolderPicker)
                    .AllowMultiSelect = False
                    .InitialFileName = "Please select Files Folder"
                    .Title = "Please select Files Folder"
            MsgBox "Please select Folder"
            If .Show = True Then
                selectedpath = .SelectedItems(1) & "\"
            Else
                MsgBox "User has cancelled"
                Exit Sub
            End If
    End With
   
    For Each strpath In fso.getfolder(selectedpath).Files
        Workbooks.Open strpath
        Z = ActiveWorkbook.Sheets.Count
        y = 0
        For Sheets_Count = ActiveWorkbook.Sheets.Count To 1 Step -1
            x = Workbooks("OutputFile.xlsx").Sheets.Count
            y = y + 1
            ActiveWorkbook.Sheets(Sheets_Count).Copy after:=Workbooks("OutputFile.xlsx").Sheets(x)
            Workbooks("OutputFile.xlsx").Save
            If y = 2 Then
                strpath1 = Right(strpath, Len(strpath) - Len(selectedpath))
                Workbooks(strpath1).Close
                Exit For
            End If
        Next Sheets_Count
        If Z = 1 Then
            strpath1 = Right(strpath, Len(strpath) - Len(selectedpath))
            Workbooks(strpath1).Close
        End If
    Next strpath
End Sub

--------------------------------------------------------------------------------------------------------------------------

Copying sheets from one file to multiple files

Sub Consolidation_Sheets()

Dim Sheets_Count As Integer
Dim fso As Object
Dim selectedpath As String
Dim strpath As Object

Application.DisplayAlerts = False

Set fso = CreateObject("scripting.filesystemobject")

    With Application.FileDialog(msoFileDialogFolderPicker)
                    .AllowMultiSelect = False
                    .InitialFileName = "Please select Files Folder"
                    .Title = "Please select Files Folder"
            MsgBox "Please select Folder"
            If .Show = True Then
                selectedpath = .SelectedItems(1) & "\"
            Else
                MsgBox "User has cancelled"
                Exit Sub
            End If
    End With
   
    For Each strpath In fso.getfolder(selectedpath).Files
        If Right(strpath, Len(strpath) - Len(selectedpath)) = "Testing.xlsx" Then
            Workbooks.Open strpath
            Exit For
        End If
    Next strpath
   
    For Each strpath In fso.getfolder(selectedpath).Files
        If Right(strpath, Len(strpath) - Len(selectedpath)) <> "Testing.xlsx" Or Right(strpath, Len(strpath) - Len(selectedpath)) <> "~$Testing.xlsx" Then
            Workbooks.Open strpath
            strpath1 = Right(strpath, Len(strpath) - Len(selectedpath))
            Workbooks("Testing.xlsx").Sheets(Workbooks("Testing.xlsx").Sheets.Count).Copy after:=Workbooks(strpath1).Sheets(Workbooks(strpath1).Sheets.Count)
            Workbooks("Testing.xlsx").Sheets(Workbooks("Testing.xlsx").Sheets.Count - 1).Copy after:=Workbooks(strpath1).Sheets(Workbooks(strpath1).Sheets.Count)
            Workbooks(strpath1).Save
            Workbooks(strpath1).Close
        End If
    Next strpath
    Workbooks("Testing.xlsx").Close

End Sub
 


 

How to automate Calculator using VBScript

Set objshell = wscript.CreateObject("wscript.shell")
objshell.Run "calc.exe"
objshell.AppActivate "Calculator"
wscript.sleep 2000
objshell.SendKeys "23*23="
msgbox "completed"

Develop this code in notepad and save it as .vbs

How to consolidate excel workbooks with multiple excel sheets using vba code

The below vba code is to consolidate for excel sheets and excel files. This code meets your consolidation requirement and no need to worry about whether you have sheets or workbooks, however it will understand your requirement and perform accordingly.

1.  Copy the below code and paste it in vba editor and save, otherwise it will get an error.
2.  And the Consolidated file will gonna save in the location where your macro file saved.

Sub ConsolidateBooksandSheets()

Dim selectedpath As String
Dim strpath As Object
Dim fso As Object
Dim SheetsCount As Integer
Dim LastColumn, LastRow As Integer

Application.DisplayAlerts = False

Set fso = CreateObject("scripting.filesystemobject")
selectedpath = "C:\Users\KorampT\Desktop\Miscellaneous" & "\" 'Give your files location path
Workbooks.Add
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & "Consolidated File.xlsx" ' The consolidated file will save where thisworkbook saved

    For Each strpath In fso.getfolder(selectedpath).Files
       
        If Right(strpath, 5) = ".xlsx" Or Right(strpath, 4) = ".xlsx" Or Right(strpath, 5) = ".xlsb" Then

            Workbooks.Open strpath
           
            If ActiveWorkbook.Sheets.Count > Workbooks("Consolidated File.xlsx").Sheets.Count Then
                a = ActiveWorkbook.Sheets.Count
                b = Workbooks("Consolidated File.xlsx").Sheets.Count
                For c = b + 1 To a
                    Workbooks("Consolidated File.xlsx").Sheets.Add after:=Sheets(c - 1)
                Next c
            End If
            For SheetsCount = 1 To ActiveWorkbook.Sheets.Count
                ActiveWorkbook.Sheets(SheetsCount).Activate
                LastColumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
                LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
                If ActiveSheet.Range("a1").Value <> "" Then
                    If Workbooks("Consolidated File.xlsx").Sheets(SheetsCount).Range("a1").Value = "" Then
                        ActiveSheet.Range(Cells(1, 1), Cells(LastRow, LastColumn)).Copy
                        Workbooks("Consolidated File.xlsx").Sheets(SheetsCount).Range("a" & Workbooks("Consolidated File.xlsx").Sheets(SheetsCount).Cells(Rows.Count, 1).End(xlUp).Row).PasteSpecial
                        Workbooks("Consolidated File.xlsx").Sheets(SheetsCount).Name = ActiveSheet.Name
                    Else
                        ActiveSheet.Range(Cells(2, 1), Cells(LastRow, LastColumn)).Copy
                        Workbooks("Consolidated File.xlsx").Sheets(SheetsCount).Range("a" & Workbooks("Consolidated File.xlsx").Sheets(SheetsCount).Cells(Rows.Count, 1).End(xlUp).Row + 1).PasteSpecial
                    End If
                End If
           
            Next SheetsCount
            ActiveWorkbook.Close
           
        End If
    Next strpath
    Workbooks("Consolidated File.xlsx").Save
End Sub

How to read pdf file using vba code

Sub Readpdffile()

Dim selectedpath as string
Dim app as Acrobat.AcroApp
Dim avdoc as Acrobat.AcroAVDoc
Dim pddoc as Acrobat.AcroPDDoc
Dim JSO as object

selectedpath = "C:\Users\Test\Desktop\Walden Design.pdf"

Set app = CreateObject("acroexch.app")
Set avdoc = CreateObject("acroexch.avdoc")


        If avdoc.Open(selectedpath, "") = True Then
                    avdoc.BringToFront
                    Set pddoc = avdoc.GetPDDoc
                    Set JSO = pddoc.GetJSObject
                     For y = 0 to pddoc.GetNumPages - 1
                              For x = 0 To JSO.getpagenumwords - 1
                                      Debug.print  JSO.getpagenthword(y,x)
                                       call JSO.selectpagenthword(y,x)
                              next x
                     next y
        end if
        avdoc.close 1
        app.exit

End sub