File format extension doesn't match when linking in email.

DanSMT

Board Regular
Joined
Sep 13, 2019
Messages
72
Hi all,

I'm having an issue when attempting to generate an email with a link to a file that is generated within the same macro.

1607613171649.png


I'm trying to make it so that specific people will receive the email and then will be able to open the link without error.

I've include the script below;

VBA Code:
Sub SuperCB_Click()
'Search last row last row in all sheets

Dim Answer As String
Answer = InputBox("What's the password?", "Password")
If Answer = "smt1234" Then

Dim WSheet As Worksheet
Dim lastRow As Long
Dim oWbLog As Workbook
Dim oWsDue As Worksheet
Dim iStatus As Long
Application.ScreenUpdating = False

  Dim Found As Boolean
  Dim InxWbk As Long
  Dim MasterList As Workbook

  Found = False
  For InxWbk = 1 To Workbooks.Count
    If Workbooks(InxWbk).Name = "Book1.xlsm" Then
      Set MasterList = Workbooks(InxWbk)
      Found = True
      Exit For
    End If
  Next

  If Not Found Then
    Set MasterList = Workbooks.Open(ThisWorkbook.Path & "\Book1.xlsm")
  End If

Set oWsDue = Workbooks.Add.Sheets(1)
    Application.DisplayAlerts = False
    oWsDue.Parent.SaveAs ("F:\HLA\Torque System\Due.xls")
    Application.DisplayAlerts = True
  
Workbooks("Book1.xlsm").Activate

    For Each WSheet In Worksheets
    
    With WSheet
        
        lastRow = .Range("A" & Rows.Count).End(xlUp).row
      
            If .Range("J" & lastRow).Value = "<>" Then
            
            ElseIf .Range("A" & lastRow).Value < Date Then
    
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lastCol As Long
Dim lDestLastRow As Long

  Set wsCopy = WSheet
  Set wsDest = Workbooks("Due.xls").Worksheets("Sheet1")

    lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, 1).End(xlUp).row

    lastCol = wsCopy.Cells(2, wsCopy.Columns.Count).End(xlToLeft).Column

    lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).row

With wsCopy
    .Range(.Cells(1, 1), .Cells(lCopyLastRow, lastCol)).Copy wsDest.Range("A" & lDestLastRow)
End With
            End If
End With
    Next WSheet
    
    Dim OutApp      As Object
    Dim OutMail     As Object
    Dim strbody     As String
    
    If ActiveWorkbook.Path <> "" Then
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)

        strbody = "!!!THIS IS A TEST!!!<br><br><br>""Please use the following link to access the" & " " & _
                  ActiveWorkbook.Name & "</B> spreadsheet document.<br>" & _
                  "Review past due torque verifications by employee number.<br>" & _
                  "Click on this link to open the file : " & _
                  "<A HREF=""F:/HLA/Torque System/Due.xls"">Link to the file</A><br><br>" & _
                  "Please update all past due torques.<br>" & _
                  "<br><br>Thank you."

        On Error Resume Next
        With OutMail
            .To = "dans@teamsmt.local"
            .Subject = "Overdue Torque Calibration" & " - " & Date
            .HTMLBody = strbody
            .Send
        End With
        On Error GoTo 0

        Set OutMail = Nothing
        Set OutApp = Nothing
    Else
        MsgBox "The ActiveWorkbook does not have a path, Save the file first."
    End If

Workbooks("due.xls").Worksheets("sheet1").Activate
Workbooks("due.xls").Worksheets("sheet1").Columns("A:K").AutoFit
Workbooks("due.xls").Save

Else: MsgBox "Wrong password", vbCritical + vbOKCancel, "Incorrect Password"
End If

End Sub
 

Some videos you may like

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December

DanSMT

Board Regular
Joined
Sep 13, 2019
Messages
72
Adding to the issue.

It appears the file saves as an old copy of excel as shown below;

1607615880978.png
 

DanSMT

Board Regular
Joined
Sep 13, 2019
Messages
72
Fixed!

.xls file is not compatible with this function and causes an error. saving as .xlsx works without error.
 
Solution

Watch MrExcel Video

Forum statistics

Threads
1,123,253
Messages
5,600,544
Members
414,387
Latest member
Vincent88

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top