PDA

View Full Version : Migrated to Office 365 from Office 2016 - MACRO no longer functions



foxyginger
10-13-2017, 10:25 AM
I created this MACRO with the help of the wonderful forum users here and it worked perfectly, until our department migrated to Office 365 from Office 2013/2016. If anyone can help me get this running again, please help. The two e-mails it creates at the end are not functional and sometimes (depending on the user) the pdf file created is now in html format.




Dim ExcelFile As StringDim PDFfile As String


Sub ProcessEquityETLandEmail()
Call IfAnalysis


End Sub


Sub IfAnalysis()


If (Cells(12, 6) = 1) Then
Call CreateExcelandEmail
Call CreatePDFandEmailwithExcel


Else
Call CreateExcelandEmail
End If


End Sub


Sub CreatePDFandEmailwithExcel()


Workbooks("Revised equity transaction request form.xlsm").Activate
ThisWorkbook.Sheets("Equity Wire").Activate


ActiveWindow.SmallScroll Down:=36
Range("B47:J77").Select
Selection.Copy
Workbooks.Add
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Columns("A:I").Select
Columns("A:I").EntireColumn.AutoFit
Range("A3:I30").Select
Application.CutCopyMode = False
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone


With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With


With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With


With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With


With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With


Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("B5").Select
Selection.NumberFormat = "m/d/yyyy"
Range("C1").Select
Selection.Font.Bold = True
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone


With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With


Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone


With Selection.Font
.Name = "Calibri"
.Size = 13
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With


With Range("F4:I31").Select
Selection.Style = "Comma"
Range("F3:F30").Select
Selection.Style = "Percent"
Range("K5").Select
ActiveWindow.View = xlPageBreakPreview
ActiveSheet.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
ActiveWindow.View = xlNormalView
ActiveWindow.SmallScroll Down:=-12
End With


Dim Path As String
Dim FileName1 As String
Dim FileName2 As String
Dim FileName3 As String


Path = "M:\"
FileName1 = Range("B3")
FileName2 = Format(Range("B4").Value, "mm-dd-yyyy")
FileName3 = "Wire Information"


PDFfile = Path & FileName1 & " " & FileName2 & " " & FileName3 & ".pdf"
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFfile


Dim OutLookApp As Object
Dim OutLookMailItem As Object
Dim myAttachments As Object


Set OutLookApp = CreateObject("OutLook.Application")
Set OutLookMailItem = OutLookApp.CreateItem(0)
Set myAttachments = OutLookMailItem.Attachments
With OutLookMailItem
.To = "GAM Cash Management"
.Subject = "Equity ETL and Wire Information"
.Body = "Please wire the attached Equity ETL." & vbNewLine & vbNewLine & "Thank you,"
myAttachments.Add PDFfile
myAttachments.Add ExcelFile
.Display
End With


Set OutLookMailItem = Nothing
Set OutLookApp = Nothing


End Sub


Sub CreateExcelandEmail()


Sheets("ETL").Select
Cells.Select
Selection.Copy
Workbooks.Add
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Cells.EntireColumn.AutoFit
Range("C7").Select
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "DATA"
Application.CutCopyMode = False


Dim Path As String
Dim FileName1 As String
Dim FileName2 As String
Dim FileName3 As String


Path = "M:\"
FileName1 = Range("C3")
FileName2 = Format(Range("D3").Value, "mm-dd-yyyy")
FileName3 = "Equity ETL"


ExcelFile = Path & FileName1 & " " & FileName2 & " " & FileName3 & ".xlsx"
ActiveWorkbook.SaveAs Filename:=ExcelFile, FileFormat:=xlOpenXMLWorkbook


Dim OutLookApp As Object
Dim OutLookMailItem As Object
Dim myAttachments As Object


Set OutLookApp = CreateObject("OutLook.Application")
Set OutLookMailItem = OutLookApp.CreateItem(0)
Set myAttachments = OutLookMailItem.Attachments
With OutLookMailItem
.To = " "
.Subject = "Equity ETL"
.Body = "Please process the attached Equity ETL." & vbNewLine & vbNewLine & "Thank you,"
myAttachments.Add ExcelFile
.Display
End With


Set OutLookMailItem = Nothing
Set OutLookApp = Nothing


End Sub




Thank you!

Kenneth Hobs
10-13-2017, 11:59 AM
When you export it, use ActiveSheet, not ActiveWorkbook, or the Sheet(s) as the object. e.g.

'ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFfile
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFfile
ThisWorkbook.Sheets("Equity Wire").ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFfile


Activate, ActiveWindow, Select, and Selection, are seldom needed. In the first part, this confuses me:

Workbooks("Revised equity transaction request form.xlsm").Activate
ThisWorkbook.Sheets("Equity Wire").Activate
The first Activate will cause an Error if that workbook is not open. IF, the first line is ThisWorkbook, just use it. No Activate is needed. I guess you can if there is potential others may be open. Howsoever, you can always set it. If WorkSheets("Equity Wire") is what you need to act with, rather than Activate, just refer to it. e.g.

'ThisWorkbook.Sheets("Equity Wire").Activate
'ActiveWindow.SmallScroll Down:=36
'Range("B47:J77").Select
'Selection.Copy
ThisWorkbook.Sheets("Equity Wire").Range("B47:J77").Copy