How To Really Publish Excel Data To Power BI … Part Deux (amended again)

It has been brought to my attention that  the formatting I chose for my Blog post on this makes for a difficult to copy and paste the code I listed into an Excel module without significant effort (like fixing doub;t-quotes, single quotes and unrequested spaces, etc.)

I am very sorry about that.

I have fixed that issue with an alternative format on the original posting here:

https://dmoffat.wordpress.com/2016/09/29/how-to-really-publish-excel-data-to-power-bi-part-deux/

But here is is again ..

Dim PT As PivotTable
   Dim Target As Workbook
   Dim intSheet As Long
   Dim c As Range
   Dim LO As ListObject
   Dim LO2 As ListObject
   Dim conn As Variant

'Created by DMoffat dick@plogic.ca 09/29/2016

Sub PBILocal()

'<< Local code required to prep for Publish to PBI >>

End Sub

Sub PowerBI()

 On Error GoTo PBIErr

 PBIInstantiate

 Application.ScreenUpdating = False

PBILocal

Set Target = Workbooks.Add
   intSheet = 1
   ThisWorkbook.Activate

 Set LO = Worksheets("PBI_Main").ListObjects("tblPBIWorksheets")

 For Each c In LO.DataBodyRange.Columns(1).Cells
    If Not IsEmpty(c) Then PBIExcelCode
   Next c

 PBIInfo

 Application.ScreenUpdating = True

 Target.SaveAs Range("'" & ThisWorkbook.Name & "'!PBIExcelTarget").Value & Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5) & ".xlsx", FileFormat:=xlOpenXMLWorkbook
   Target.Close False

 Range("PBILastPublished").Value = Now()

 ThisWorkbook.Save

 MsgBox "PBI Update Complete", vbInformation + vbOKOnly, "PBI Update"
   Exit Sub

PBIErr:
   MsgBox Err.Description & " - Please report this error to your Adminstrator immediately.", vbCritical, "PBI Update Error"
   Application.ScreenUpdating = True
   Exit Sub

End Sub

Sub PBIInstantiate()

Dim WS As Worksheet
   Dim boolFound As Boolean

 boolFound = False
   For Each WS In Worksheets
   If WS.Name = "PBI_Main" Then
   boolFound = True
   Exit For
   End If
   Next WS

If boolFound = True Then
   Exit Sub
   Else
   ThisWorkbook.Sheets.Add , Worksheets(ThisWorkbook.Worksheets.Count)
   With ActiveSheet
   .Name = "PBI_Main"

 With .Cells(3, 1)
   .Value = "PBIExcelTarget"
   With .Offset(0, 1)
   .Name = "PBIExcelTarget"
   .Interior.ColorIndex = 20
   .Value = "<<URL to OneDrive or SharePoint Folder>>"
   End With
   End With

 With .Cells(4, 1)
   .Value = "PBITargetFile"
   With .Offset(0, 1)
   .Name = "PBITargetFile"
   .Interior.ColorIndex = 20
   .FormulaR1C1 = "=PBIExcelTarget&PBIGetFileName()"
   End With
   End With

 With .Cells(5, 1)
   .Value = "PBILastPublished"
   With .Offset(0, 1)
   .Name = "PBILastPublished"
   .Interior.ColorIndex = 20
   End With
   End With

 With .Cells(6, 1)
   .Value = "PBIPassword"
   With .Offset(0, 1)
   .Interior.ColorIndex = 20
   .Name = "PBIPassword"
   End With
   End With

 .Cells(8, 2).Value = "WorksheetName"
   .ListObjects.Add(xlSrcRange, .Cells(8, 2), , xlYes).Name = "tblPBIWorksheets"
   .Cells(8, 1).Value = "tblPBIWorksheets"
   .Columns(1).AutoFit
   End With

 End If

 ActiveSheet.Buttons.Add(20.25, 0.75, 85, 20).Select
   Selection.OnAction = "PowerBI"
   Selection.Characters.Text = "Publish To PBI"
   Cells(1, 1).Select
   End

End Sub

Sub PBIExcelCode()

 Dim TSheet As Worksheet

 If intSheet = 1 Then
   Set TSheet = Target.Worksheets(1)
   intSheet = 2
   Else
   Set TSheet = Target.Worksheets.Add
   End If

TSheet.Name = c.Value

 If ThisWorkbook.Worksheets(c.Value).PivotTables.Count = 1 Then
   Set PT = ThisWorkbook.Worksheets(c.Value).PivotTables(1)
   PT.RowRange.EntireRow.Copy
   ElseIf ThisWorkbook.Worksheets(c.Value).ListObjects.Count = 1 Then
   Set LO2 = ThisWorkbook.Worksheets(c.Value).ListObjects(1)
   LO2.Range.Copy
   Else
   MsgBox "Worksheet " & c.Value & " does not have the single Pivot Table nor Table that is required to Publish. Publish Cancelled.", vbExclamation + vbOKOnly, "Publish Failed"
   End
   End If
   With TSheet
  .Cells(1, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
   .ListObjects.Add(xlSrcRange, TSheet.Cells(1, 1).CurrentRegion, , xlYes).Name = "tbl" & c.Value
   .Cells(1, 1).CurrentRegion.Columns.EntireColumn.AutoFit
   .Protect Password:=Range("PBIPassword").Value
   End With

End Sub
  Function PBIGetFileName()

If Right(Range("PBIExcelTarget").Value, 1) = "/" Then
   txtSlash = ""
   Else
   txtSlash = "/"
   End If

 PBIGetFileName = txtSlash & Left(ThisWorkbook.Name, InStr(1, ThisWorkbook.Name, ".xls")) & "xlsx"

End Function

Sub PBIInfo()

Set TSheet = Target.Worksheets.Add
   TSheet.Name = "Info"
   With TSheet
   .Cells(1, 1).Value = "Created"
   .Cells(2, 1).Value = Now()
   .Cells(1, 2).Value = "CreatedBy"
   .Cells(2, 2).Value = Environ("username")
   .Cells(1, 3).Value = "Source"
   .Cells(2, 3).Value = ThisWorkbook.FullName
   .ListObjects.Add(xlSrcRange, TSheet.Cells(1, 1).CurrentRegion, , xlYes).Name = "tblInfo"
   .Cells(1, 1).CurrentRegion.Columns.EntireColumn.AutoFit
   .Protect Password:=Range("PBIPassword").Value
   End With

End Sub

This code should copy and paste directly into your module.

Then run the “PowerBI” procedure in that code to configure you model.  Then copy and paste the target SharePoint folder that you will be Publishing to in the PBIExcelTarget Cell in the format:

https://yourconame.sharepoint.com/Shared Documents/PowerBIFolderName

Excuse this please.. and enjoy ..

Dick