• Skip to main content
  • Skip to header right navigation
  • Skip to site footer

My Online Training Hub

Learn Dashboards, Excel, Power BI, Power Query, Power Pivot

  • Courses
  • Pricing
    • Free Courses
    • Power BI Course
    • Excel Power Query Course
    • Power Pivot and DAX Course
    • Excel Dashboard Course
    • Excel PivotTable Course – Quick Start
    • Advanced Excel Formulas Course
    • Excel Expert Advanced Excel Training
    • Excel Tables Course
    • Excel, Word, Outlook
    • Financial Modelling Course
    • Excel PivotTable Course
    • Excel for Customer Service Professionals
    • Excel for Operations Management Course
    • Excel for Decision Making Under Uncertainty Course
    • Excel for Finance Course
    • Excel Analysis ToolPak Course
    • Multi-User Pricing
  • Resources
    • Free Downloads
    • Excel Functions Explained
    • Excel Formulas
    • Excel Add-ins
    • IF Function
      • Excel IF Statement Explained
      • Excel IF AND OR Functions
      • IF Formula Builder
    • Time & Dates in Excel
      • Excel Date & Time
      • Calculating Time in Excel
      • Excel Time Calculation Tricks
      • Excel Date and Time Formatting
    • Excel Keyboard Shortcuts
    • Excel Custom Number Format Guide
    • Pivot Tables Guide
    • VLOOKUP Guide
    • ALT Codes
    • Excel VBA & Macros
    • Excel User Forms
    • VBA String Functions
  • Members
    • Login
    • Password Reset
  • Blog
  • Excel Webinars
  • Excel Forum
    • Register as Forum Member
You are here: Home
Lost password?
sp_Search
Advanced Search|Last Search Results
Advanced Search
Forum Scope




Match



Forum Options



Minimum search word length is 3 characters - maximum search word length is 84 characters
sp_Search

Please confirm you want to mark all posts read

Mark all topics read

sp_MobileMenu Actions
Actions
sp_LogInOut
Log In
sp_Search

Search Forums

sp_RankInfo
Ranks Information
Avatar

New/Updated Topics

General Excel Questions & Answers

  removing pesky hidden xml sheets in a workbook

  Sick leave periods in one cell

  Data Validation with unique values

  Amortization

Dashboards & Charts

  Connecting 2 separate pivot charts or data sets to calculate…

VBA & Macros

  Send Email Code Error

Power Query

  How to add a new query for each cell of a column

  Source doesn't exist for Power Query folder

  Create list of working days

  Power Query - How to add multiple columns from parent to Nes…

  Unpivoting data to merge rows

Xtreme Pivot Tables

  Pivot Tables - Grand Totals AND Summary Percentages in the s…

Power BI

  How identify the URL to connect power bi with Project online

Excel Expert

  new and deleted entries

  Excel Dashboard

Select Forum

  Rules and Guides

Forum Rules and Guides

  Public Forums - For Registered Users

General Excel Questions & Answers

Dashboards & Charts

VBA & Macros

Power Query

Power Pivot

  Course Members Only

Excel Dashboards

Power Query

Power Pivot

Xtreme Pivot Tables

Excel for Decision Making

Excel for Finance

Power BI

Excel

Word

Outlook

Excel Expert

Excel for Customer Service Professionals

Excel Analysis Toolpak

Excel Tables

Excel for Operations Management

Financial Modelling

Advanced Excel Formulas

Pivot Tables Quick Start

ForumsVBA & Macros
sp_TopicIcon
Macro written in 32 bit System - Not working in 64 bit System[ Win 10 and Office 2019 Prof]
123Jump to page
Avatar
David_Ng
Posts: 306
Level 0
November 18, 2020 - 6:05 pm

1

How to change the Macro Work book originally written in 32 bit System now can not work in  64 bit Windows 10 System using Office 2019

pls see attached, is there a way to convert all these codes to work in 64 bit System.

Avatar
David_Ng
Posts: 306
Level 0
November 18, 2020 - 6:44 pm

2

Attachment reload

Avatar
Miguel Santos
Posts: 80
Level 0
November 19, 2020 - 2:15 am

3

Hello,

in the following two links, you can view and obtain "Api" & "Declarations"

https://jkp-ads.com/articles/a.....ations.asp

https://www.cadsharp.com/docs/.....trSafe.txt

and see if this link can help you

https://www.codestack.net/soli.....rrect-use/

 

Miguel,

Avatar
David_Ng
Posts: 306
Level 0
November 19, 2020 - 11:10 am

4

Sorry the API and Declarations can not be downloaded from these sites ?

If downloaded and install can all macros written in 32 bit can put to work in 64 bit ? Pls help clarify and explain a little more

Avatar
Miguel Santos
Posts: 80
Level 0
November 20, 2020 - 1:04 am

5
Good afternoon everyone,

the links that I have indicated are informative sites, where you can find (constants; Declaring API Functions;...) to write in VBA for example

I took a look at your project, and just the module with the name: ( List ), is the one that reports error in 64 bits, right?

you want to have a macro to get all the information from the files in a folder, right?

you don't need API for that


example, works in 32-Bit and 64-Bit

first, add this reference to your project: “Microsoft Scripting Runtime”

ref.JPGImage Enlarger

 

next, copy all the following lines and paste in a standard module

Option Explicit

Public Sub allFilesInFolder()

If Not WorksheetExists("Files") Then 'Determine if a worksheet name exist (MACRO)
     On Error Resume Next
     Worksheets.Add.Name = "Files"
     On Error GoTo 0
End If

With Application.ThisWorkbook.Worksheets("Files")
     .Visible = xlSheetVisible
     .Activate
     On Error Resume Next
    ' .Cells.ClearFormats
     .Cells.Delete
     On Error GoTo 0
End With
PauseInEvent (0.001) ' (MACRO) to make a pause

Dim RootFolder$

RootFolder = checkDir
If RootFolder = "" Then Exit Sub

With Application.ThisWorkbook.Worksheets("Files")
     With Range("A1")
         .Formula = "Arquivos do Diretório: " & RootFolder
         .Font.Bold = True
         .Font.Size = 12
     End With

     .Range("A3").Formula = "Path:"
     .Range("B3").Formula = "Name:"
     .Range("C3").Formula = "Creation Date:"
     .Range("D3").Formula = "Last Access Date:"
     .Range("E3").Formula = "Last Modified Date:"

     With Range("A3:E3")
         .Font.Bold = True
         .HorizontalAlignment = xlCenter
         .VerticalAlignment = xlCenter
         ' .WrapText = True
     End With
     ' .Columns("A:H").Autofit
End With

ListFilesInFolder RootFolder, True

End Sub

Private Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)

Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder
Dim SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim r As Long

Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder(SourceFolderName)

With ActiveSheet
     r = Range("A65536").End(xlUp).Row + 1

     For Each FileItem In SourceFolder.Files
         Cells(r, 1).Formula = FileItem.ParentFolder
         Cells(r, 2).Formula = FileItem.Name
         Cells(r, 3).Formula = FileItem.DateCreated
         Cells(r, 3).NumberFormatLocal = "dd/mm/aaaa hh:mm:ss"
         Cells(r, 4).Formula = FileItem.DateLastAccessed
         Cells(r, 5).Formula = FileItem.DateLastModified
         Cells(r, 5).NumberFormatLocal = "dd/mm/aaaa hh:mm:ss"
         r = r + 1
     Next FileItem
     .Columns("A:H").Autofit
End With

If IncludeSubfolders Then
     For Each SubFolder In SourceFolder.SubFolders
         ListFilesInFolder SubFolder.path, True
     Next SubFolder
End If

If Not SourceFolder Is Nothing Then Set SourceFolder = Nothing
If Not FSO Is Nothing Then Set FSO = Nothing

'ActiveWorkbook.Saved = True

End Sub

Private Function checkDir()

Dim objShell, objFolder, xpath, SecuriteSlash

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Please confirm: Select the folder with the files!", &H1&)

On Error Resume Next
xpath = objFolder.ParentFolder.ParseName(objFolder.Title).path & ""

If objFolder.Title = "Bureau" Then
     xpath = "C:WindowsBureau"
End If

If objFolder.Title = "" Then
     xpath = ""
End If

SecuriteSlash = InStr(objFolder.Title, ":")

If SecuriteSlash > 0 Then
     xpath = Mid(objFolder.Title, SecuriteSlash - 1, 2) & ""
End If

checkDir = xpath

If Not objShell Is Nothing Then Set objShell = Nothing
If Not objFolder Is Nothing Then Set objFolder = Nothing

End Function

Public Function WorksheetExists(ByVal WorksheetName As String) As Boolean ' Determine if a worksheet name exists in this workbook

On Error Resume Next
     WorksheetExists = (ThisWorkbook.Sheets(WorksheetName).Name <> "")
On Error GoTo 0

End Function

Public Function PauseInEvent(ByVal Delay As Double) ' WAIT A MOMENT WITH LOOP

Dim TheEndOfTime As Double
TheEndOfTime = Timer + Delay

Do While Timer < TheEndOfTime
     DoEvents
Loop

End Function

 

place the following procedure to call the macro wherever you want:           Call allFilesInFolder

Miguel,

 
sp_PlupAttachments Attachments
  • sp_PlupImage ref.JPG (83 KB)
Avatar
A S
Posts: 6
Level 0
November 20, 2020 - 9:47 am

6

is it possible to change the code and have full path as hyperlink in column B

Avatar
David_Ng
Posts: 306
Level 0
November 20, 2020 - 12:25 pm

7

Thanks Miguel,

 

but when try re-run the macro following error pops-up-, stating  sub or Function not defined, pls help debug further

 

Function GetDirectory(Optional Msg) As String

  Dim bInfo As BROWSEINFO
    Dim path As String
    Dim r As Long, x As Long, pos As Integer

' Root folder = Desktop
    bInfo.pidlRoot = 0&

' Title in the dialog
    If IsMissing(Msg) Then
        bInfo.lpszTitle = "Select a folder."
    Else
        bInfo.lpszTitle = Msg
  End If

' Type of directory to return
    bInfo.ulFlags = &H1

' Display the dialog
    x = SHBrowseForFolder(bInfo)

' Parse the result
    path = Space$(512)
    r = SHGetPathFromIDList(ByVal x, ByVal path)
    If r Then
        pos = InStr(path, Chr$(0))
        GetDirectory = Left(path, pos - 1)
    Else
        GetDirectory = ""
  End If
End Function

Avatar
David_Ng
Posts: 306
Level 0
November 20, 2020 - 6:04 pm

8

BTW the previous macro work is all working after replace all the codes you are so kindly shared.

 

However, the  attached Email Macro not working as written in 32 bit Codes and using BSMTP21 stored in Windows System 32 directory, any  chance to modify and covert  to 64 bit and make it work again, thanks your great help

Avatar
Miguel Santos
Posts: 80
Level 0
November 21, 2020 - 2:37 am

9

Hello,

I drew attention in my previous post, that the following reference must be activated: “Microsoft Scripting Runtime”

ref-1.JPGImage Enlarger

see the previous image, if you don't, you will always have errors in excel

 

copy the following lines of code between the lines (-------------------------------------- -------------------)

and paste it into a standard module

I made the change to full.path to be in column ("B")

 

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

Option Explicit

Public Sub allFilesInFolder()

If Not WorksheetExists("Files") Then 'Determine if a worksheet name exist (MACRO)
      On Error Resume Next
      Worksheets.Add.Name = "Files"
      On Error GoTo 0
End If

With Application.ThisWorkbook.Worksheets("Files")
      .Visible = xlSheetVisible
      .Activate
      On Error Resume Next
      ' .Cells.ClearFormats
      .Cells.Delete
      On Error GoTo 0
End With
PauseInEvent (0.001) ' (MACRO) to make a pause

Dim RootFolder$

RootFolder = checkDir
If RootFolder = "" Then Exit Sub

With Application.ThisWorkbook.Worksheets("Files")
      With Range("A1")
            .Formula = "Arquivos do Diretório: " & RootFolder
            .Font.Bold = True
            .Font.Size = 12
      End With

      .Range("B3").Formula = "Path:"
      .Range("A3").Formula = "Name:"
      .Range("C3").Formula = "Creation Date:"
      .Range("D3").Formula = "Last Access Date:"
      .Range("E3").Formula = "Last Modified Date:"

      With Range("A3:E3")
            .Font.Bold = True
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            ' .WrapText = True
      End With
      ' .Columns("A:H").Autofit
End With

ListFilesInFolder RootFolder, True

End Sub

Private Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)

Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder
Dim SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim r As Long

Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder(SourceFolderName)

With ActiveSheet
      r = Range("A65536").End(xlUp).Row + 1

      For Each FileItem In SourceFolder.Files
            ' Cells(r, 1).Formula = FileItem.ParentFolder
            Cells(r, 2).Formula = FileItem.Path
            Cells(r, 1).Formula = FileItem.Name
            Cells(r, 3).Formula = FileItem.DateCreated
            Cells(r, 3).NumberFormatLocal = "dd/mm/yyyy hh:mm:ss"
            Cells(r, 4).Formula = FileItem.DateLastAccessed
            Cells(r, 5).Formula = FileItem.DateLastModified
            Cells(r, 5).NumberFormatLocal = "dd/mm/yyyy hh:mm:ss"
            r = r + 1
      Next FileItem
      .Columns("A:H").AutoFit
End With

If IncludeSubfolders Then
      For Each SubFolder In SourceFolder.SubFolders
            ListFilesInFolder SubFolder.Path, True
      Next SubFolder
End If

If Not SourceFolder Is Nothing Then Set SourceFolder = Nothing
If Not FSO Is Nothing Then Set FSO = Nothing

'ActiveWorkbook.Saved = True

End Sub

Private Function checkDir()

Dim objShell, objFolder, xpath, SecuriteSlash

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Please confirm: Select the folder with the files!", &H1&)

On Error Resume Next
xpath = objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""

If objFolder.Title = "Bureau" Then
      xpath = "C:WindowsBureau"
End If

If objFolder.Title = "" Then
      xpath = ""
End If

SecuriteSlash = InStr(objFolder.Title, ":")

If SecuriteSlash > 0 Then
      xpath = Mid(objFolder.Title, SecuriteSlash - 1, 2) & ""
End If

checkDir = xpath

If Not objShell Is Nothing Then Set objShell = Nothing
If Not objFolder Is Nothing Then Set objFolder = Nothing

End Function

Public Function WorksheetExists(ByVal WorksheetName As String) As Boolean ' Determine if a worksheet name exists in this workbook

On Error Resume Next
      WorksheetExists = (ThisWorkbook.Sheets(WorksheetName).Name <> "")
On Error GoTo 0

End Function

Public Function PauseInEvent(ByVal Delay As Double) ' WAIT A MOMENT WITH LOOP

Dim TheEndOfTime As Double
TheEndOfTime = Timer + Delay

Do While Timer < TheEndOfTime
      DoEvents
Loop

End Function

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

 

example to call this macro:

Private Sub CommandButton4_Click()

Call allFilesInFolder

End Sub

 

you must save your Excel files to support macros (.xlsm), other formats will give errors, see the following link

https://support.microsoft.com/.....c7889ff74a

 

only now will I be able to see your other post

 

Miguel,

sp_PlupAttachments Attachments
  • sp_PlupImage ref-1.JPG (83 KB)
Avatar
Miguel Santos
Posts: 80
Level 0
November 21, 2020 - 3:17 am

10

Hello,

for email see the following links, if you still have questions, say

 

https://www.myonlinetraininghu.....th-outlook

https://www.myonlinetraininghu.....le-reports

 

Miguel,

Avatar
David_Ng
Posts: 306
Level 0
November 21, 2020 - 10:27 am

11

Thanks Miguel,basically the "List Files" Macro error already fixed after follows your advice to modify the code.
But, I am stuck with the Email Macro as still prompt the codes must be upgraded [ 64 Bit ], can you help further how to modify and debug the codes to make it work with Ms.Office 2019 version

Avatar
A S
Posts: 6
Level 0
November 21, 2020 - 10:40 pm

12

Thanks Miguel for changing the code to get path in column B but I was hoping more to get hyperlink in column B that I can click on it and get file open

Avatar
Miguel Santos
Posts: 80
Level 0
November 22, 2020 - 10:01 pm

13

Hello,

to send by outlook, insert the following code in a standard module

 

Option Explicit

Public Sub SendOutlookEmail()

Dim objfile As FileSystemObject
Dim xNewFolder As Variant
Dim outlApp As Outlook.Application
Dim outlEmail As Outlook.MailItem
Dim outlName As Outlook.Namespace
Dim xEmailOut As String, xEmailCC As String, xEmailBCC As String, xlist As String
Dim xDir As String, convertDate As String, xFile As String, xPath As String, xAttach As String
Dim xDate As Date
Dim xCol As Long
Dim myWorkb As Workbook, xWorkb As Workbook, thisPath As String

thisPath = ActiveWorkbook.Path & "\"

Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Application.StatusBar = "Please wait ... Outlook email creation procedures in progress!"

Set myWorkb = ActiveWorkbook
xDate = VBA.Date
myWorkb.Sheets(Array("Sheet1", "Sheet2", "Sheet6", "Sheet100","Sheet88")).Copy ' select the sheets (names) of this workbook that you want to include in the copy of this workbook that will be sent

Set xWorkb = ActiveWorkbook

''--------------------------------------------------
''--------------------------------------------------
''--- if we want some sheets of the selection to be invisible to those who will receive the workbook, we must activate and indicate in the next lines
'Range("A1").Select
'xWorkb.Sheets("Sheet1").Visible = False
'xWorkb.Sheets("Sheet2").Visible = False
'xWorkb.Sheets("Sheet3").Visible = False
'xWorkb.Sheets("Sheet4").Visible = False
''...
'xWorkb.Sheets("Sheet6").Select
''--------------------------------------------------
''--------------------------------------------------

xDir = thisPath
convertDate = VBA.Format(xDate, "dd mm yyyy") & "\"
xFile = "new workbook name to be sent " & VBA.Format(xDate, "dd-mm-yyyy") & ".xlsm" ' Full name of the workbook to be created and sent (copies of selected sheets of this workbook)
xPath = xDir & convertDate & xFile

Set objfile = New FileSystemObject

If objfile.FolderExists(xDir & convertDate) Then
          If objfile.FileExists(xPath) Then
                    objfile.DeleteFile (xPath)
                    xWorkb.SaveAs Filename:=xPath, FileFormat:=xlOpenXMLWorkbook, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
                    Application.ActiveWorkbook.Close
          Else
                    xWorkb.SaveAs Filename:=xPath, FileFormat:=xlOpenXMLWorkbook, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
                    Application.ActiveWorkbook.Close
          End If
Else
          xNewFolder = xDir & convertDate
          MkDir xNewFolder
          xWorkb.SaveAs Filename:=xPath, FileFormat:=xlOpenXMLWorkbook, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
          Application.ActiveWorkbook.Close
End If

''>>>>>>>>>>>>>>>>>>>> CHOOSE ONLY ONE OPTION (1 or 2) >>>>>>>>>>>>>>>>>>>>''
'
' OPTION 1 - if you choose this option, you must disable option 2
''--------------------------------------------------
''--------------------------------------------------
''--- if there is an email list in excel sheet, activate the following lines of code
''--- in this example the first line = 2 (with email data), the column ("A") is the (send to), the column ("B") is (send CC), the column ("C") is ( send BCC)
'With myWorkb
'           .Activate
'           .Worksheets("list_of_emails").Visible = True

'           .Worksheets("list_of_emails").Unprotect "1234" ' if protected
'           .Worksheets("list_of_emails").Select
'End With
'
'xEmailOut = "" ' reset/clear
'xEmailCC = "" ' reset/clear
'xEmailBCC = "" ' reset/clear
'
'xCol = 1
'
'Do Until xCol = 4 ' we limited the first 3 columns ("A & B & C")
'           Cells(2, xCol).Select
'           Do Until ActiveCell = ""
'                     xlist = ActiveCell.Value
'                     If xCol = 1 Then xEmailOut = xEmailOut & xlist & "; "
'                     If xCol = 2 Then xEmailCC = xEmailCC & xlist & "; "
'                    If xCol = 3 Then xEmailBCC = xEmailBCC & xlist & "; "
'                     ActiveCell.Offset(1, 0).Select
'          Loop
'          xCol = xCol + 1
'Loop
'
'Range("A1").Select
''--------------------------------------------------
''--------------------------------------------------

' OPTION 2 - if you choose this option, you must disable option 1
''--------------------------------------------------
''--------------------------------------------------
''--- enter the destination email in each of the options
xEmailOut = " " ' insert email here
xEmailCC = " " ' insert email here
xEmailBCC = " " ' insert email here
''--------------------------------------------------
''--------------------------------------------------
''<<<<<<<<<<<<<<<<<<<< CHOOSE ONLY ONE OPTION (1 or 2) <<<<<<<<<<<<<<<<<<<<''

Set outlApp = New Outlook.Application
Set outlName = outlApp.GetNamespace("MAPI")
outlName.Logon

Set outlEmail = outlApp.CreateItem(olMailItem)
outlEmail.To = xEmailOut
outlEmail.CC = xEmailCC
outlEmail.BCC = xEmailBCC
outlEmail.Subject = "Description of the subject text of the email" ' email subject text
outlEmail.Body = vbCrLf & "Hello my friend," _
          & vbCrLf & vbCrLf & "I send a file of our work on the subject in title with the following name: " & VBA.Mid(xFile, 1, VBA.Len(xFile) - 5) & "." _
          & vbCrLf & vbCrLf & "See you soon my friend." _
          & vbCrLf & "Regards," _
          & vbCrLf & vbCrLf & " " _
          & vbCrLf & vbCrLf & " " _
          & vbCrLf & "my name!" _
          & vbCrLf & "my email address!" _
          & vbCrLf & "my phone number!" ' email body

outlEmail.Attachments.Add xPath ' attach the newly created copy of the workbook

''--------------------------------------------------
''--------------------------------------------------
''--- if you want to attach other files, activate the following lines and indicate the full path
'xAttach = "C:\...\4.5.JPG"
'outlEmail.Attachments.Add xAttach ' attach picture
'xAttach = "C:\...\my file.xlsm"
'outlEmail.Attachments.Add xAttach ' attach file
''...
''--------------------------------------------------
''--------------------------------------------------

outlEmail.Display

If Not outlEmail Is nothyng Then Set outlEmail = Nothing
If Not outlName Is nothyng Then Set outlName = Nothing
If Not outlApp Is nothyng Then Set outlApp = Nothing
If Not objfile Is nothyng Then Set objfile = Nothing
If Not xWorkb Is nothyng Then Set xWorkb = Nothing
If Not myWorkb Is nothyng Then Set myWorkb = Nothing

Application.StatusBar = False
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

 

example of how to call the macro (with command button)

 

Option Explicit

Private Sub CommandButton1_Click()

Call SendOutlookEmail

End Sub

 

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

 

insert the following code in the sheet where you have the full path of each file, recorded in cells

clicking on a cell, if the path is valid will open the file

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim xPath As String

xPath = Target.Value

Debug.Print xPath

If xPath <> "" Then
          If FileExist(xPath) = False Then GoTo resumeExit:
          Application.ThisWorkbook.FollowHyperlink (xPath)
End If

Exit Sub
resumeExit:
          ' MsgBox "File not found!", vbCritical, "Information!"
          Exit Sub
End Sub

Public Function FileExist(FilePath As String) As Boolean

Dim TestStr As String

On Error Resume Next
TestStr = Dir(FilePath)
On Error GoTo 0

If TestStr = "" Then
          FileExist = False
Else
          FileExist = True
End If

End Function

 

Miguel,

Avatar
A S
Posts: 6
Level 0
November 23, 2020 - 2:26 am

14

Thanks!

Avatar
David_Ng
Posts: 306
Level 0
November 23, 2020 - 10:49 am

15

Thanks Miguel so much ! Ask a bit more , can you put these Email macro codes to a workbook, then we can  try.

Avatar
Miguel Santos
Posts: 80
Level 0
November 24, 2020 - 2:23 am

16

Hello,

I apologize, when writing the code here manually, and when trying to color and space the lines, I made typos

my code is much more extensive and I had removed some parts, along with file attachment with full code

 

Miguel,

Avatar
David_Ng
Posts: 306
Level 0
November 24, 2020 - 10:36 am

17

Thanks Miguel, will try on these!

Can the macro modified to pick up a pdf attachment from a designated Folder eg c:\Data\*a.pdf, b.pdf,c.pdf d.pdf, x.pdf,y.pdf, m,pdf  z.pdf  etc etc etc

and email via outlook to specific recipient [ base on a Master Email address list] together with the related attachment pdf file.  [ generated by System]

Avatar
Miguel Santos
Posts: 80
Level 0
November 24, 2020 - 4:02 pm

18

Hello,

yes, you just need to add the email addresses in Worksheets ("list_of_emails") in the columns ("A" & /or "B" &/or "C"), 
and put all the file paths to be attached in the column ("D"), and if it is an (example) file: PDF just created, 
when creating it, add the path in a column line ("D"), 
and to use it all, activate the two "options 1" in the macro and disable the two "options 2"

Miguel,
Avatar
David_Ng
Posts: 306
Level 0
November 26, 2020 - 6:54 pm

19

Dear Miguel,

 

I attached the macro file with layout modified per your suggested format   can you help put back the VB codes to send with pdf  as attachment to related recipient. 

Avatar
Miguel Santos
Posts: 80
Level 0
November 27, 2020 - 6:10 am

20

Hello,

the file you placed, has no module, that is, only the excel  sheets!

the excel file I provided in post 16 works perfectly with Outlook in 32 or 64 bits, and sends any type of file

if in column ("D") the paths of the files inserted there are incorrect, or after checking the macro, 
determine that it does not exist in the indicated location, 
the macro will not attach them to the Outlook message

review what you are doing wrong

I send a new attachment of the same file

do a test according to my file, before any changes, just put the email addresses in the columns ("A, B, C") 
and the paths of the files to be attached in the column lines ("D" ), click the command button button in the excel spreadsheet

Miguel,

123Jump to page
Forum Timezone:
Australia/Brisbane
Most Users Ever Online: 245
Currently Online: Alan Sidman, Rebecca Berneck, Emma Klonowski, Peter Hoffman, Marco Marques, Natasha Smith
Guest(s) 10
Currently Browsing this Page:
1 Guest(s)

Devices in use: Desktop (13), Phone (3)

Forum Stats:
Groups: 3
Forums: 24
Topics: 6212
Posts: 27236
Member Stats:
Guest Posters: 49
Members: 31888
Moderators: 3
Admins: 4
© Simple:Press

Sidebar

Blog Categories

  • Excel
  • Excel Charts
  • Excel Dashboard
  • Excel Formulas
  • Excel PivotTables
  • Excel Shortcuts
  • Excel VBA
  • General Tips
  • Online Training
  • Outlook
  • Power Apps
  • Power Automate
  • Power BI
  • Power Pivot
  • Power Query
microsoft mvp logo
trustpilot excellent rating
Secured by Sucuri Badge
MyOnlineTrainingHub on YouTube Mynda Treacy on Linked In Mynda Treacy on Instagram Mynda Treacy on Twitter Mynda Treacy on Pinterest MyOnlineTrainingHub on Facebook
 

Company

  • About My Online Training Hub
  • Disclosure Statement
  • Frequently Asked Questions
  • Guarantee
  • Privacy Policy
  • Terms & Conditions
  • Testimonials
  • Become an Affiliate

Support

  • Contact
  • Forum
  • Helpdesk - For Technical Issues

Copyright © 2023 · My Online Training Hub · All Rights Reserved. Microsoft and the Microsoft Office logo are trademarks or registered trademarks of Microsoft Corporation in the United States and/or other countries. Product names, logos, brands, and other trademarks featured or referred to within this website are the property of their respective trademark holders.