Advanced Error Handling in MS Access

This VBA snippet will execute the following actions:

• Save error details in tblErrorLog table
• It will add the current method if it does not exist in tblVBAMethods table
• Allow user to report the error which by sending an email with screen dump taken and attached automatically

The script is referencing the following tables:

      CREATE TABLE tblErrorLog(

            ErrorID LONG AUTOINCREMENT,

            MethodID TEXT(255) NOT NULL,

            LineNo LONG NOT NULL,

            ErrorNo LONG NOT NULL,

            ErrorDescription MEMO NOT NULL,

            DateCreated DATETIME NOT NULL,

            CreatedBy TEXT(255) NOT NULL,

            DateModified DATETIME,

            ModifiedBy TEXT(255)

);

CREATE TABLE tblVBAMethods(

    MethodID TEXT(255) NOT NULL,

    Component TEXT(100) NOT NULL,

    Method TEXT(100) NOT NULL,

    DateCreated DATETIME NOT NULL,

    CreatedBy TEXT(255) NOT NULL,

    DateModified DATETIME,

    ModifiedBy TEXT(255)

);

CREATE TABLE tblVBAComponents(

    Component TEXT(100) NOT NULL,

    IsSelected BOOL,

    DateCreated DATETIME NOT NULL,

    CreatedBy TEXT(255) NOT NULL,

    DateModified DATETIME,

    ModifiedBy TEXT(255)

);

CREATE TABLE tblAppSettings(

    ConstID TEXT(255) NOT NULL,

    ConstDesc TEXT(255) NOT NULL,

    ConstValue TEXT(255) NOT NULL,

    DateCreated DATETIME NOT NULL,

    CreatedBy TEXT(255) NOT NULL,

    DateModified DATETIME,

    ModifiedBy TEXT(255)

);

Option Compare Database

Option Explicit

Option Base 1

Function TestErrorMessage()

On Error GoTo ErrorExit

    Dim RaiseVal As Integer

10      RaiseVal = 1 / 0

NormalExit:

    Exit Function

ErrorExit:

    ErrNumber = Err.Number: ErrDescription = Err.Description: LineNo = Erl

    MethodID = VBE.ActiveCodePane.CodeModule.Name + "." + GetFnOrSubName(Erl)

    WhereIs = "Raised on line " + IIf(CStr(LineNo) = "0", "Unknown", CStr(LineNo)) + " of " + MethodID + " method."

    ErrorPrompt = "Error " + CStr(ErrNumber) + " - " + ErrDescription

    ErrorID = LogError(MethodID, LineNo, ErrNumber, ErrDescription)

    Answer = MsgBox(WhereIs + ". " + vbCr + vbCr + "Do you want to report it?", (vbCritical + vbQuestion + vbYesNo + vbDefaultButton2), ErrorPrompt)

    If Answer = vbYes Then Call ReportError(ErrorID): Resume NormalExit

End Function

Function LogError(MethodID As String, LineNo As Variant, ErrNumber As Integer, ErrDescription As String) As Long

On Error GoTo ErrorExit

    Dim strMsg As String, strSql As String, ErrorID As Long, StartDateTime As Date, strWhere As String, MethodCounter As Integer _

        , Scope As String, Component As String, Method As String

        StartDateTime = Now()

        LogError = 0

        Call InitApp

        MethodCounter = DCount("*", "tblVBAMethods", "MethodID = '" + MethodID + "'")

        If MethodCounter = 0 Then

            Scope = VBE.ActiveCodePane.CodeModule.Name

            Component = VBE.SelectedVBComponent.Name

            Method = Mid(MethodID, InStr(1, MethodID, ".") + 1, Len(MethodID))

            Call AddMethod(MethodID, Scope, Component, Method, SeekerEmail, StartDateTime)

        End If

        strSql = "INSERT INTO tblErrorLog ( MethodID, LineNo, ErrorNo, ErrorDeScription, DateCreated, CreatedBy)"

        strSql = strSql + " VALUES('" + MethodID + "'"

        strSql = strSql + ", '" + CStr(LineNo) + "'"

        strSql = strSql + ", '" + CStr(ErrNumber) + "'"

        strSql = strSql + ", '" + ErrDescription + "'"

        strSql = strSql + ", '" + CStr(StartDateTime) + "'"

        strSql = strSql + ", '" + SeekerEmail + "')"

        DoCmd.SetWarnings False

        DoCmd.RunSQL strSql

        DoCmd.SetWarnings True

        strWhere = "CStr(DateCreated) = '" + CStr(StartDateTime) + "' and CreatedBy = '" + SeekerEmail + "'"

        LogError = DLookup("ErrorID", "tblErrorLog", strWhere)

NormalExit:

    Exit Function

ErrorExit:

    ErrNumber = Err.Number: ErrDescription = Err.Description: LineNo = Erl

    MethodID = VBE.ActiveCodePane.CodeModule.Name + "." + GetFnOrSubName(Erl)

    WhereIs = "Raised on line " + IIf(CStr(LineNo) = "0", "Unknown", CStr(LineNo)) + " of " + MethodID + " method."

    ErrorPrompt = "Error " + CStr(ErrNumber) + " - " + ErrDescription

    ErrorID = LogError(MethodID, LineNo, ErrNumber, ErrDescription)

    Answer = MsgBox(WhereIs + ". " + vbCr + vbCr + "Do you want to report it?", (vbCritical + vbQuestion + vbYesNo + vbDefaultButton2), ErrorPrompt)

    If Answer = vbYes Then Call ReportError(ErrorID): Resume NormalExit

End Function

Function ReportError(ErrorID As Long) As Boolean

On Error GoTo ErrorExit

    Dim Style As Variant, Title As Variant, SupportEmail As String, RetVal As String, TestVal As Boolean, frmMsg As String _

        , PowerShellFile As String, BMPfile As String, waitOnReturn As Boolean, windowStyle As Integer

        ReportError = False

        windowStyle = 1: waitOnReturn = True

        Call PrintScreen

        SupportEmail = Nz(DLookup("ConstValue", "tblAppSettings", "ConstID='SupportEmail'"), vbNullString)

        PowerShellFile = Application.CurrentProject.path + "\ErrorMessages\" + SeekerEmail + "\" + "SpoolClipboardImageToBMPfile.ps1"

        BMPfile = Application.CurrentProject.path + "\ErrorMessages\" + SeekerEmail + "\"

        BMPfile = BMPfile + "Error_" + Format$(Now, "yyyy_mm_dd_hh_mm_ss") + ".bmp"

        TestVal = SpoolClipboardImageToBMPfile(PowerShellFile, BMPfile)

        If Not TestVal Then GoTo NormalExit

        TestVal = SendEmail(EmailTo:=SupportEmail _

            , EmailSubject:=ErrorPrompt + WhereIs _

            , EmailBody:="ErrorID is " + CStr(ErrorID) _

            , Attachment:=BMPfile)

        Call Pause(2)

        If Not TestVal Then GoTo NormalExit

        TestVal = LetsDeleteFile(BMPfile)

        If Not TestVal Then GoTo NormalExit

        ReportError = True

NormalExit:

    Exit Function

ErrorExit:

    ErrNumber = Err.Number: ErrDescription = Err.Description: LineNo = Erl

    MethodID = VBE.ActiveCodePane.CodeModule.Name + "." + GetFnOrSubName(Erl)

    WhereIs = "Raised on line " + IIf(CStr(LineNo) = "0", "Unknown", CStr(LineNo)) + " of " + MethodID + " method."

    ErrorPrompt = "Error " + CStr(ErrNumber) + " - " + ErrDescription

    ErrorID = LogError(MethodID, LineNo, ErrNumber, ErrDescription)

    Answer = MsgBox(WhereIs + ". " + vbCr + vbCr + "Do you want to report it?", (vbCritical + vbQuestion + vbYesNo + vbDefaultButton2), ErrorPrompt)

    If Answer = vbYes Then Call ReportError(ErrorID): Resume NormalExit

End Function

Function GetFnOrSubName(handlerLabel As String) As String

On Error GoTo ErrorExit

    Dim VBProj As VBIDE.VBProject, vbComp As VBIDE.VBComponent, CodeMod As VBIDE.CodeModule, code$, handlerAt&, isFunction&, isSub&

        Set VBProj = VBE.ActiveVBProject

        Set vbComp = VBProj.VBComponents(VBE.ActiveCodePane.CodeModule.Name)

        Set CodeMod = vbComp.CodeModule

        code = CodeMod.Lines(1, CodeMod.CountOfLines)

        handlerAt = InStr(1, code, handlerLabel, vbTextCompare)

        If handlerAt Then

            isFunction = InStrRev(Mid$(code, 1, handlerAt), "Function", -1, vbTextCompare)

            isSub = InStrRev(Mid$(code, 1, handlerAt), "Sub", -1, vbTextCompare)

            If isFunction > isSub Then

                'It's a function

                GetFnOrSubName = Replace(Split(Mid$(code, isFunction, 40), "(")(0), "Function ", vbNullString)

            Else

                'It's a sub

                GetFnOrSubName = Replace(Split(Mid$(code, isSub, 40), "(")(0), "Sub ", vbNullString)

            End If

        End If

NormalExit:

    Exit Function

ErrorExit:

    ErrNumber = Err.Number: ErrDescription = Err.Description: LineNo = Erl

    MethodID = VBE.ActiveCodePane.CodeModule.Name + "." + GetFnOrSubName(Erl)

    WhereIs = "Raised on line " + IIf(CStr(LineNo) = "0", "Unknown", CStr(LineNo)) + " of " + MethodID + " method."

    ErrorPrompt = "Error " + CStr(ErrNumber) + " - " + ErrDescription

    ErrorID = LogError(MethodID, LineNo, ErrNumber, ErrDescription)

    Answer = MsgBox(WhereIs + ". " + vbCr + vbCr + "Do you want to report it?", (vbCritical + vbQuestion + vbYesNo + vbDefaultButton2), ErrorPrompt)

    If Answer = vbYes Then Call ReportError(ErrorID): Resume NormalExit

End Function

Sub PrintScreen()

    keybd_event VK_SNAPSHOT, 1, 0, 0

End Sub

Function SpoolClipboardImageToBMPfile(PowerShellFile As String, BMPfile As String) As Boolean

On Error GoTo ErrorExit

    Dim objWScript As Object, psCmd As String, TestVal As Integer, MkDirFavorites As String, WshExec As Object _

        , waitOnReturn As Boolean, windowStyle As Integer, ErrorCode As Integer

        SpoolClipboardImageToBMPfile = False

        Set objWScript = CreateObject("WScript.Shell")

         psCmd = "get-clipboard -format image" + vbCr

        psCmd = psCmd + "$img = get-clipboard -format image" + vbCr

        psCmd = psCmd + "$img.save('" + BMPfile + "')" + vbCr

        TestVal = LetsDeleteFile(PowerShellFile)

        If Not TestVal Then GoTo NormalExit

        TestVal = LetsCreateFile(PowerShellFile, psCmd)

        If Not TestVal Then GoTo NormalExit

        psCmd = "Powershell -File """ + PowerShellFile + """"

        ErrorCode = objWScript.Run(psCmd, vbHide, waitOnReturn)

        If ErrorCode > 0 Then GoTo NormalExit

        SpoolClipboardImageToBMPfile = True

NormalExit:

    Set objWScript = Nothing

    Exit Function

ErrorExit:

    ErrNumber = Err.Number: ErrDescription = Err.Description: LineNo = Erl

    MethodID = VBE.ActiveCodePane.CodeModule.Name + "." + GetFnOrSubName(Erl)

    WhereIs = "Raised on line " + IIf(CStr(LineNo) = "0", "Unknown", CStr(LineNo)) + " of " + MethodID + " method."

    ErrorPrompt = "Error " + CStr(ErrNumber) + " - " + ErrDescription

    ErrorID = LogError(MethodID, LineNo, ErrNumber, ErrDescription)

    Answer = MsgBox(WhereIs + ". " + vbCr + vbCr + "Do you want to report it?", (vbCritical + vbQuestion + vbYesNo + vbDefaultButton2), ErrorPrompt)

    If Answer = vbYes Then Call ReportError(ErrorID): Resume NormalExit

End Function

If you find this script useful please donate generously. 

This PowerShell script will create a folder in your Sharepoint 365 Document Library

Add-Type -Path "C:\Program Files\Common Files\Microsoft Shared\Web Server Extensions\16\ISAPI\Microsoft.SharePoint.Client.dll"

Add-Type -Path "C:\Program Files\Common Files\Microsoft Shared\Web Server Extensions\16\ISAPI\Microsoft.SharePoint.Client.Runtime.dll"

### function to create a log for the report in csv
function WriteLog{param ([Parameter(Mandatory=$true)] $type, $folderName,$name,$path,$fileCount,$fileSize,$remark)
$nowTime=Get-Date -format "dd-MMM-yy,HH:mm:ss"
$folderName = $folderName.replace(",","|") ### sometime folder / file name has comma so replace it with something
$name = $name.replace(",","|")
$path = $path.replace(",","|")
$lineContent = "$($nowTime),$($type),$($folderName),$($name),$($path),$($fileCount),$($fileSize),$($remark)"
Add-Content -Path $global:OutFilePath -Value "$lineContent"
$global:Processed = $global:Processed + 1
}
function ScanFolders{
param ([Parameter(Mandatory=$true)] $srcfolder, $parentName)
$remarkDetail = ""
$replacedUser=""
Write-Host "Total Count: $($global:SourceCount) Completed: $($global:Processed)" -ForegroundColor Cyan
Write-Host "Navigate to: " $srcfolder.ServerRelativeUrl -ForegroundColor Yellow
$folderItem = $srcfolder.ListItemAllFields
#$srcContext.Load($f)
$srcContext.Load($folderItem)
$srcContext.ExecuteQuery()
$authorEmail = $folderItem["Author"].Email
$editorEmail = $folderItem["Editor"].Email
$filepath = $folderItem["FileDirRef"]
#$fileSize = $fItem["File_x0020_Size"]
$fileName = $srcfolder.Name
$fileCol = $srcfolder.Files
$srcContext.Load($fileCol)
$srcContext.ExecuteQuery()
WriteLog "Folder" $parentName $fileName $filepath $fileCol.Count 0 $remarkDetail
foreach ($f in $fileCol){
$remarkDetail = ""
$replacedUser=""
$fItem = $f.ListItemAllFields
#$srcContext.Load($f)
$srcContext.Load($fItem)
$srcContext.ExecuteQuery()
$authorEmail = $fItem["Author"].Email
$editorEmail = $fItem["Editor"].Email
$filepath = $fItem["FileDirRef"]
$fileSize = $fItem["File_x0020_Size"]
$fileName = $fItem["FileLeafRef"]
WriteLog "File" $srcfolder.Name $fileName $filepath 0 $fileSize $remarkDetail
}
$fL1FolderColl = $srcfolder.Folders
$srcContext.Load($fL1FolderColl);
$srcContext.ExecuteQuery();
foreach ($myFolder in $fL1FolderColl){
$srcContext.Load($myFolder)
$srcContext.ExecuteQuery()
ScanFolders $myFolder $srcfolder.Name
}
}

function Release-Ref ($ref) {
([System.Runtime.InteropServices.Marshal]::ReleaseComObject(
[System.__ComObject]$ref) -gt 0)
[System.GC]::Collect()
[System.GC]::WaitForPendingFinalizers()
}

function Set-WindowStyle {
param(
[Parameter()]
[ValidateSet('FORCEMINIMIZE', 'HIDE', 'MAXIMIZE', 'MINIMIZE', 'RESTORE',
'SHOW', 'SHOWDEFAULT', 'SHOWMAXIMIZED', 'SHOWMINIMIZED',
'SHOWMINNOACTIVE', 'SHOWNA', 'SHOWNOACTIVATE', 'SHOWNORMAL')]
$Style = 'SHOW',
[Parameter()]
$MainWindowHandle = (Get-Process -Id $pid).MainWindowHandle
)
    $WindowStates = @{
        FORCEMINIMIZE   = 11; HIDE            = 0
        MAXIMIZE        = 3;  MINIMIZE        = 6
        RESTORE         = 9;  SHOW            = 5
        SHOWDEFAULT     = 10; SHOWMAXIMIZED   = 3
        SHOWMINIMIZED   = 2;  SHOWMINNOACTIVE = 7
        SHOWNA          = 8;  SHOWNOACTIVATE  = 4
        SHOWNORMAL      = 1
    }
    Write-Verbose ("Set Window Style {1} on handle {0}" -f $MainWindowHandle, $($WindowStates[$style]))
    $Win32ShowWindowAsync = Add-Type –memberDefinition @”
    [DllImport("user32.dll")]
    public static extern bool ShowWindowAsync(IntPtr hWnd, int nCmdShow);
“@ -name “Win32ShowWindowAsync” -namespace Win32Functions –passThru
    $Win32ShowWindowAsync::ShowWindowAsync($MainWindowHandle, $WindowStates[$Style]) | Out-Null
}

$now=Get-Date -format "dd-MMM-yy,HH:mm:ss"
$fileFormat = Get-Date -format "dd-MMM-yy_HHmmss"
Write-Host "Script Start : '$($now)'" -ForegroundColor Yellow
$global:SourceCount = 0    ### To know the total count of the documents to be processed
$global:Processed = 0
$global:OutFilePath = "C:\Export\files_" + $fileFormat + ".csv"
Write-Host "Exporting $global:OutFilePath"
$header = "Date,Time,Type,Parent,Name,Path,FilesCount,FileSize(bytes),Remark"
Add-Content -Path $global:OutFilePath -Value "`n $header"
$CredPath = "C:\SharedToAnyone\OneDriveUpload\Credential\cred.txt"
$UserName = "$env:USERNAME@$env:USERDNSDOMAIN"
if (!(Test-Path $CredPath)){
    read-host -assecurestring | convertfrom-securestring | out-file $CredPath
} else {
    $StoredPsw = Get-Content -Path $CredPath
    $password = get-content $CredPath | convertto-securestring
}
$credentials = New-Object Microsoft.SharePoint.Client.SharePointOnlineCredentials($UserName,$password)
$srcUrl = "https://domain.sharepoint.com" ### https://domain/sites/<sitename>
$srcLibrary = "Documents"
#$srcLibrary = "Shared Documents"

### The script starts here to run ####
Write-Host "Authenticating ..." -ForegroundColor White
$srcContext = New-Object Microsoft.SharePoint.Client.ClientContext($srcUrl)
$srcContext.Credentials = $credentials
$srcWeb = $srcContext.Web
$srcList = $srcWeb.Lists.GetByTitle($srcLibrary)
$query = New-Object Microsoft.SharePoint.Client.CamlQuery
$listItems = $srcList.GetItems($query)
$srcContext.Load($srcList)
$srcContext.Load($listItems)
$srcContext.ExecuteQuery()
$global:SourceCount = $srcList.ItemCount
Write-Host "Total Count: $($global:SourceCount)" -ForegroundColor Cyan
foreach($item in $listItems){
if($item.FileSystemObjectType -eq "File"){
$remarkDetail = ""
$replacedUser=""
$srcF = $item.File
$fItem = $srcF.ListItemAllFields
$srcContext.Load($srcF)
$srcContext.Load($fItem)
$srcContext.ExecuteQuery()
$authorEmail = $fItem["Author"].Email
$editorEmail = $fItem["Editor"].Email
$filepath = $fItem["FileDirRef"]
$fileSize = $fItem["File_x0020_Size"]
$fileName = $fItem["FileLeafRef"]
WriteLog "File" "Root" $fileName $filepath 0 $fileSize $remarkDetail
} elseif ($item.FileSystemObjectType -eq "Folder"){
$srcContext.Load($item)
$srcContext.ExecuteQuery()
$folder = $srcWeb.GetFolderByServerRelativeUrl($item.FieldValues["FileRef"].ToString())
$srcContext.Load($folder)
$srcContext.ExecuteQuery()
ScanFolders $folder "Root"
}
}
$now=Get-Date -format "dd-MMM-yy,HH:mm:ss"
Write-Host "Total Count: $($global:SourceCount) Completed: $($global:Processed)" -ForegroundColor Cyan
Write-Host "END Start : '$($now)'" -ForegroundColor Yellow
$objExcel = new-object -comobject excel.application
$objWorkbook = $objExcel.Workbooks.Open($global:OutFilePath)
$objExcel.Visible = $True
$objExcel.DisplayFullScreen = $true
$a = Release-Ref($objExcel)
$a = Release-Ref($objWorkbook)
(Get-Process -Name excel).MainWindowHandle | foreach { Set-WindowStyle SHOWNA $_ }

Generate Report of Sharepoint 365 Document Library

This PowerShell script exports the Sharepoint 365 Document Library into .csv file.

cls
Add-Type -Path "C:\Program Files\Common Files\Microsoft Shared\Web Server Extensions\16\ISAPI\Microsoft.SharePoint.Client.dll"
Add-Type -Path "C:\Program Files\Common Files\Microsoft Shared\Web Server Extensions\16\ISAPI\Microsoft.SharePoint.Client.Runtime.dll"

### function to create a log for the report in csv
function WriteLog{param ([Parameter(Mandatory=$true)] $type, $folderName,$name,$path,$fileCount,$fileSize,$remark)
$nowTime=Get-Date -format "dd-MMM-yy,HH:mm:ss"
$folderName = $folderName.replace(",","|") ### sometime folder / file name has comma so replace it with something
$name = $name.replace(",","|")
$path = $path.replace(",","|")
$lineContent = "$($nowTime),$($type),$($folderName),$($name),$($path),$($fileCount),$($fileSize),$($remark)"
Add-Content -Path $global:OutFilePath -Value "$lineContent"
$global:Processed = $global:Processed + 1
}
function ScanFolders{
param ([Parameter(Mandatory=$true)] $srcfolder, $parentName)
$remarkDetail = ""
$replacedUser=""
Write-Host "Total Count: $($global:SourceCount) Completed: $($global:Processed)" -ForegroundColor Cyan
Write-Host "Navigate to: " $srcfolder.ServerRelativeUrl -ForegroundColor Yellow
$folderItem = $srcfolder.ListItemAllFields
#$srcContext.Load($f)
$srcContext.Load($folderItem)
$srcContext.ExecuteQuery()
$authorEmail = $folderItem["Author"].Email
$editorEmail = $folderItem["Editor"].Email
$filepath = $folderItem["FileDirRef"]
#$fileSize = $fItem["File_x0020_Size"]
$fileName = $srcfolder.Name
$fileCol = $srcfolder.Files
$srcContext.Load($fileCol)
$srcContext.ExecuteQuery()
WriteLog "Folder" $parentName $fileName $filepath $fileCol.Count 0 $remarkDetail
foreach ($f in $fileCol){
$remarkDetail = ""
$replacedUser=""
$fItem = $f.ListItemAllFields
#$srcContext.Load($f)
$srcContext.Load($fItem)
$srcContext.ExecuteQuery()
$authorEmail = $fItem["Author"].Email
$editorEmail = $fItem["Editor"].Email
$filepath = $fItem["FileDirRef"]
$fileSize = $fItem["File_x0020_Size"]
$fileName = $fItem["FileLeafRef"]
WriteLog "File" $srcfolder.Name $fileName $filepath 0 $fileSize $remarkDetail
}
$fL1FolderColl = $srcfolder.Folders
$srcContext.Load($fL1FolderColl);
$srcContext.ExecuteQuery();
foreach ($myFolder in $fL1FolderColl){
$srcContext.Load($myFolder)
$srcContext.ExecuteQuery()
ScanFolders $myFolder $srcfolder.Name
}
}

function Release-Ref ($ref) {
([System.Runtime.InteropServices.Marshal]::ReleaseComObject(
[System.__ComObject]$ref) -gt 0)
[System.GC]::Collect()
[System.GC]::WaitForPendingFinalizers()
}

function Set-WindowStyle {
param(
[Parameter()]
[ValidateSet('FORCEMINIMIZE', 'HIDE', 'MAXIMIZE', 'MINIMIZE', 'RESTORE',
'SHOW', 'SHOWDEFAULT', 'SHOWMAXIMIZED', 'SHOWMINIMIZED',
'SHOWMINNOACTIVE', 'SHOWNA', 'SHOWNOACTIVATE', 'SHOWNORMAL')]
$Style = 'SHOW',
[Parameter()]
$MainWindowHandle = (Get-Process -Id $pid).MainWindowHandle
)
    $WindowStates = @{
        FORCEMINIMIZE   = 11; HIDE            = 0
        MAXIMIZE        = 3;  MINIMIZE        = 6
        RESTORE         = 9;  SHOW            = 5
        SHOWDEFAULT     = 10; SHOWMAXIMIZED   = 3
        SHOWMINIMIZED   = 2;  SHOWMINNOACTIVE = 7
        SHOWNA          = 8;  SHOWNOACTIVATE  = 4
        SHOWNORMAL      = 1
    }
    Write-Verbose ("Set Window Style {1} on handle {0}" -f $MainWindowHandle, $($WindowStates[$style]))
    $Win32ShowWindowAsync = Add-Type –memberDefinition @”
    [DllImport("user32.dll")]
    public static extern bool ShowWindowAsync(IntPtr hWnd, int nCmdShow);
“@ -name “Win32ShowWindowAsync” -namespace Win32Functions –passThru
    $Win32ShowWindowAsync::ShowWindowAsync($MainWindowHandle, $WindowStates[$Style]) | Out-Null
}

$now=Get-Date -format "dd-MMM-yy,HH:mm:ss"
$fileFormat = Get-Date -format "dd-MMM-yy_HHmmss"
Write-Host "Script Start : '$($now)'" -ForegroundColor Yellow
$global:SourceCount = 0    ### To know the total count of the documents to be processed
$global:Processed = 0
$global:OutFilePath = "C:\Export\files_" + $fileFormat + ".csv"
Write-Host "Exporting $global:OutFilePath"
$header = "Date,Time,Type,Parent,Name,Path,FilesCount,FileSize(bytes),Remark"
Add-Content -Path $global:OutFilePath -Value "`n $header"
$CredPath = "C:\SharedToAnyone\OneDriveUpload\Credential\cred.txt"
$UserName = "$env:USERNAME@$env:USERDNSDOMAIN"
if (!(Test-Path $CredPath)){
    read-host -assecurestring | convertfrom-securestring | out-file $CredPath
} else {
    $StoredPsw = Get-Content -Path $CredPath
    $password = get-content $CredPath | convertto-securestring
}
$credentials = New-Object Microsoft.SharePoint.Client.SharePointOnlineCredentials($UserName,$password)
$srcUrl = "https://domain.sharepoint.com" ### https://domain/sites/<sitename>
$srcLibrary = "Documents"
#$srcLibrary = "Shared Documents"

### The script starts here to run ####
Write-Host "Authenticating ..." -ForegroundColor White
$srcContext = New-Object Microsoft.SharePoint.Client.ClientContext($srcUrl)
$srcContext.Credentials = $credentials
$srcWeb = $srcContext.Web
$srcList = $srcWeb.Lists.GetByTitle($srcLibrary)
$query = New-Object Microsoft.SharePoint.Client.CamlQuery
$listItems = $srcList.GetItems($query)
$srcContext.Load($srcList)
$srcContext.Load($listItems)
$srcContext.ExecuteQuery()
$global:SourceCount = $srcList.ItemCount
Write-Host "Total Count: $($global:SourceCount)" -ForegroundColor Cyan
foreach($item in $listItems){
if($item.FileSystemObjectType -eq "File"){
$remarkDetail = ""
$replacedUser=""
$srcF = $item.File
$fItem = $srcF.ListItemAllFields
$srcContext.Load($srcF)
$srcContext.Load($fItem)
$srcContext.ExecuteQuery()
$authorEmail = $fItem["Author"].Email
$editorEmail = $fItem["Editor"].Email
$filepath = $fItem["FileDirRef"]
$fileSize = $fItem["File_x0020_Size"]
$fileName = $fItem["FileLeafRef"]
WriteLog "File" "Root" $fileName $filepath 0 $fileSize $remarkDetail
} elseif ($item.FileSystemObjectType -eq "Folder"){
$srcContext.Load($item)
$srcContext.ExecuteQuery()
$folder = $srcWeb.GetFolderByServerRelativeUrl($item.FieldValues["FileRef"].ToString())
$srcContext.Load($folder)
$srcContext.ExecuteQuery()
ScanFolders $folder "Root"
}
}
$now=Get-Date -format "dd-MMM-yy,HH:mm:ss"
Write-Host "Total Count: $($global:SourceCount) Completed: $($global:Processed)" -ForegroundColor Cyan
Write-Host "END Start : '$($now)'" -ForegroundColor Yellow
$objExcel = new-object -comobject excel.application
$objWorkbook = $objExcel.Workbooks.Open($global:OutFilePath)
$objExcel.Visible = $True
$objExcel.DisplayFullScreen = $true
$a = Release-Ref($objExcel)
$a = Release-Ref($objWorkbook)
(Get-Process -Name excel).MainWindowHandle | foreach { Set-WindowStyle SHOWNA $_ }

Describe attributes of user defined function which resides on remote server using Link Service

The following procedure describes attributes of user defined function which resides on remote server using Link Service and stores it to ##temp table.

USE YourDB
GO

SET ANSI_NULLS ON
GO

SET QUOTED_IDENTIFIER ON
GO

SET ANSI_WARNINGS OFF
GO

PRINT 'Date: ' + CONVERT(VARCHAR(24),GETDATE(),13) + '   Server Name: ' 

+ @@servername + '   Service Name: ' + @@servicename;
GO

IF EXISTS
    (SELECT *
    FROM sys.objects
    WHERE name = 'Describe_Remote_UDF_Attributes')
    drop procedure reporting.Describe_Remote_UDF_Attributes;
PRINT 'drop procedure reporting.Describe_Remote_UDF_Attributes';
GO

PRINT 'CREATE PROCEDURE reporting.Describe_Remote_UDF_Attributes';
GO

CREATE PROC reporting.Describe_Remote_UDF_Attributes
/*****************************************************************************
Description:  This procedure describes attributes of user defined function

 which resides on remote server using Link Service and stores it to ##temp table.

Change Log
 #    Date       Who  Change
*****************************************************************************/ 
       @runUDF            NVARCHAR(MAX)
      ,@LinkServiceName NVARCHAR(256)
AS
    BEGIN

            SET NOCOUNT ON;
            DECLARE  @strExe NVARCHAR(MAX) = 'sp_describe_first_result_set @tsql = N'''
                    ,@strExecAt  NVARCHAR(MAX);
                IF OBJECT_ID('tempdb..##temp') IS NOT NULL  DROP TABLE ##temp;

                CREATE TABLE ##temp (
                    is_hidden                            sql_variant
                    ,column_ordinal                        sql_variant
                    ,name                                sql_variant
                    ,is_nullable                        sql_variant
                    ,system_type_id                     sql_variant
                    ,system_type_name                   sql_variant
                    ,max_length                         sql_variant
                    ,[precision]                        sql_variant
                    ,scale                              sql_variant
                    ,collation_name                     sql_variant
                    ,user_type_id                       sql_variant
                    ,user_type_database                 sql_variant
                    ,user_type_schema                   sql_variant
                    ,user_type_name                     sql_variant
                    ,assembly_qualified_type_name       sql_variant
                    ,xml_collection_id                  sql_variant
                    ,xml_collection_database            sql_variant
                    ,xml_collection_schema              sql_variant
                    ,xml_collection_name                sql_variant
                    ,is_xml_document                    sql_variant
                    ,is_case_sensitive                  sql_variant
                    ,is_fixed_length_clr_type           sql_variant
                    ,source_server                      sql_variant
                    ,source_database                    sql_variant
                    ,source_schema                      sql_variant
                    ,source_table                       sql_variant
                    ,source_column                      sql_variant
                    ,is_identity_column                 sql_variant
                    ,is_part_of_unique_key              sql_variant
                    ,is_updateable                      sql_variant
                    ,is_computed_column                 sql_variant
                    ,is_sparse_column_set               sql_variant
                    ,ordinal_in_order_by_list           sql_variant
                    ,order_by_is_descending             sql_variant
                    ,order_by_list_length               sql_variant
                    ,tds_type_id                        sql_variant
                    ,tds_length                         sql_variant
                    ,tds_collation_id                   sql_variant
                    ,tds_collation_sort_id              sql_variant
                );

                SET @strExe = @strExe + '''SELECT * FROM ' + @runUDF + '''';
                SET @strExecAt = 'INSERT INTO ##temp EXEC (''' + @strExe + ''''') AT ' 

                    + @LinkServiceName;

                EXEC(@strExecAt);
    END;
/***********************************************
Test Sample:

EXEC reporting.Describe_Remote_UDF_Attributes 
    'YourSchema.dbo.YourUDF( 
                default            
                ,default            
                ,default        
                ,default        
                ,default            
                )'

    ,'LinkServiceName';

 SELECT * FROM     ##temp;
*************************************************/
GO

If you find this script useful please donate generously.

Dynamically transpose an object (Table or View) by swapping rows and columns around

The following PROC will dynamically transpose an object (Table or View) by swapping rows and columns around.

USE YourDB
GO

SET ANSI_NULLS ON
GO

SET QUOTED_IDENTIFIER ON
GO

SET ANSI_WARNINGS OFF
GO

PRINT 'Date: ' + CONVERT(VARCHAR(24),GETDATE(),13) + '   Server Name: ' 

+ @@servername + '   Service Name: ' + @@servicename
GO

IF EXISTS
 (SELECT *
 FROM sys.objects
 WHERE name = 'TransposeObject')
 drop procedure YourSchemaTransposeObject

PRINT 'drop procedure YourSchema.TransposeObject'
GO

PRINT 'CREATE PROCEDURE YourSchema.TransposeObject'
GO

CREATE PROCEDURE YourSchema.TransposeObject
  @SchemaName NVARCHAR(256)
 ,@ObjectName NVARCHAR(256)
/*********************************************************************************
 Description : Dynamically transpose an object (Table or View) by swapping rows and columns

 Requirements: The object (Table or View which name passed as a parameter to this PROC) must have
     the following structure:
 
 ObjectName  (RowNo INT
     ,Title NVARCHAR(256)
     ,YourFieldName ATTRIBUTE
     ...
     ,YourFieldName ATTRIBUTE)
 
 Limitations: This PROC will execute a serious INSERT SELECT and UPDATE SELECT statements.

     The size of these DML commands are limited by NVARCHAR(MAX).  The PROC perfomance will decrease with

     the number of the Object fields increase.  View aliases must not have single quotes.

 Modification History:

 Date    Description
 *********************************************************************************/

AS
 BEGIN
  BEGIN TRY
   SET NOCOUNT ON;

   DECLARE  @Value    NVARCHAR(256)
     ,@Counter   INT = 1
     ,@UnpivotRecs  INT
     ,@Rec    INT = 1
     ,@strSQLivotRecs INT
     ,@strSQL   NVARCHAR(MAX);

   IF OBJECT_ID('tempdb..##tblNoRecs') IS NOT NULL DROP TABLE ##tblNoRecs;
   CREATE TABLE ##tblNoRecs(NoRecs INT);

   SET @strSQL = 'INSERT INTO ##tblNoRecs SELECT COUNT(*) FROM ' + @SchemaName + '.' + @ObjectName + ';';

   EXEC (@strSQL);
   SELECT @UnpivotRecs = NoRecs  FROM ##tblNoRecs;
   IF OBJECT_ID('tempdb..##tblPivot') IS NOT NULL DROP TABLE ##tblPivot
   SET @strSQL = 'CREATE TABLE ##tblPivot(RowNo INT, Title sql_variant'
   WHILE @Counter <= @UnpivotRecs BEGIN
    SET @strSQL = @strSQL + ',Value'  + CAST(@Counter AS VARCHAR(8)) + ' sql_variant'
    SET @Counter = @Counter + 1;
   END;
   SET @strSQL = @strSQL + ');'

   EXEC (@strSQL);
   SET @Counter = 1;
   SET @strSQL = 'INSERT INTO ##tblPivot SELECT RowNo = ORDINAL_POSITION, Title = COLUMN_NAME'
   WHILE @Counter <= @UnpivotRecs BEGIN
    SET @strSQL = @strSQL + ',Value'  + CAST(@Counter AS VARCHAR(8)) + ' =  NULL'
    SET @Counter = @Counter + 1;
   END;
   SET @strSQL = @strSQL + ' FROM INFORMATION_SCHEMA.COLUMNS WHERE TABLE_NAME = ''' + @ObjectName + ''';'
   EXEC (@strSQL);
   SET @Counter = 2;
   SET @strSQLivotRecs = (SELECT COUNT(*) FROM ##tblPivot)

   WHILE @Counter <= @strSQLivotRecs BEGIN
    SET @strSQL = 'UPDATE ##tblPivot ';
    WHILE @Rec <= @UnpivotRecs BEGIN
     IF @Rec <> 1  SET @strSQL = @strSQL + ', '
     ELSE SET @strSQL = @strSQL + ' SET ';
     
     SELECT @Value = CAST(Title AS VARCHAR(255)) FROM ##tblPivot WHERE RowNo = CAST(@Counter AS VARCHAR(8));

     SET @strSQL = @strSQL + 'Value' + CAST(@Rec AS VARCHAR(8)) + ' = (SELECT ' + @Value + ' FROM ' +  @SchemaName + '.' + @ObjectName + ' WHERE RowNo = ' + CAST(@Rec AS VARCHAR(8)) + ')';
     SET @Rec = @Rec + 1;
    END;
    SET @Rec = 1;
    SET @strSQL = @strSQL + ' WHERE RowNo = ' + CAST(@Counter AS VARCHAR(8));
    SET @Counter = @Counter + 1;

    EXEC (@strSQL);
   END; 

   SET @strSQL = '';
   SELECT @strSQL = @strSQL + NAME + ','
   FROM  tempdb.sys.columns Where object_id=OBJECT_ID('tempdb.dbo.##tblPivot');
   SET @strSQL = SUBSTRING(@strSQL, CHARINDEX(',', @strSQL) + 1, LEN(@strSQL) - CHARINDEX(',', @strSQL) - 1 );
   SET @strSQL = 'SELECT FriendlyTitle = (SELECT K2_Ext.Training.SpaceBeforeCap(CONVERT(NVARCHAR(MAX), Title))), ' + @strSQL + ' FROM ##tblPivot WHERE Title <> ''RowNo''';
  

   EXEC (@strSQL);
ExitLabel:
  END TRY
   BEGIN CATCH
    SELECT   ERROR_NUMBER() AS ErrorNumber 
      ,ERROR_SEVERITY() AS ErrorSeverity 
      ,ERROR_STATE() AS ErrorState 
      ,ERROR_PROCEDURE() AS ErrorProcedure 
      ,ERROR_LINE() AS ErrorLine 
      ,ERROR_MESSAGE() AS ErrorMessage; 
   END CATCH;
 END;
/*********************************************************************************
Test Sample:

SELECT * FROM YourSchema.YearlyFiguresUnpivot

EXEC YourDB.YourSchema.TransposeObject
 'Training'     -- @SchemaName
 ,'YearlyFiguresUnpivot'  -- @ObjectName
 

SELECT * FROMYourSchema.MonthlyFiguresUnpivot
EXEC YourDB.YourSchema.TransposeObject
 'Training'     -- @SchemaName
 ,'MonthlyFiguresUnpivot' -- @ObjectName
 
*********************************************************************************/
GO

The PROC calls the following UDF:

USE YourDB
GO

SET ANSI_NULLS ON
GO

SET QUOTED_IDENTIFIER ON
GO

PRINT 'Date: ' + CONVERT(VARCHAR(24),GETDATE(),13) + '   Server Name: ' + @@servername + '   Service Name: ' + @@servicename
GO

IF EXISTS
      (SELECT *
    FROM sys.objects
    WHERE name = 'SpaceBeforeCap')
  DROP FUNCTION YourSchema.SpaceBeforeCap
  PRINT 'DROP FUNCTION YourSchema.SpaceBeforeCap'

GO

PRINT 'CREATE FUNCTION YourSchema.SpaceBeforeCap'
GO

CREATE FUNCTION YourSchema.SpaceBeforeCap
/*********************************************************************************
Inserts Space Before Cap

Change Log

 #    Date       Who  Change
*********************************************************************************/  (@str NVARCHAR(MAX))
RETURNS NVARCHAR(MAX)
AS
 BEGIN
   DECLARE  @result NVARCHAR(MAX) = LEFT(@str, 1)
     ,@i  INT = 2;
   WHILE @i <= len(@str) BEGIN
  IF ASCII(SUBSTRING(@str, @i, 1)) BETWEEN 65 AND 90
   SET @result += ' ';
   SET @result += SUBSTRING(@str, @i, 1);
   SET @i += 1;
   END;
   RETURN @result;
 END;

/*********************************************************************************
Test Sample:

SELECT FriendlyTitle = YourDB.YourSchema.SpaceBeforeCap('ThisIsATestString')

*********************************************************************************/
GO

If you find this script useful please donate generously.

Dump a procedure result set into a temporary table by leveraging on sys.dm_exec_describe_first_result_set_for_object function introduced in MS SQL Server 2012

The following script creates a temporary table with attributes defined dynamically based on metadata using sys.dm_exec_describe_first_result_set_for_object function out of a stored procedure.
It populates this table by inserting the recordset returning by this stored procedure.

IF OBJECT_ID('tempdb..##tmp') IS NOT NULL DROP Table ##tmp
GO

DECLARE @strSQL VARCHAR(MAX) 

WITH cte AS (
SELECT 'CREATE TABLE ##tmp(' strSQL
UNION ALL
SELECT strSQL = ',' + name + ' ' + system_type_name
FROM sys.dm_exec_describe_first_result_set_for_object
(OBJECT_ID('myschema.dbo.MyProc'), NULL)
UNION ALL
SELECT strSQL = ')')

SELECT @strSQL = COALESCE(@strSQL, '') +  strSQL
FROM cte
WHERE strSQL IS NOT NULL
OPTION (MAXDOP 1);

SET @strSQL = REPLACE(@strSQL,'(,','(');

EXEC (@strSQL);

INSERT INTO ##tmp
EXEC myschema.dbo.MyProc
    5512712        --@Field1    INT
    ....
    ,NULL;        --@FieldN    VARCHAR(15)

SELECT * FROM ##tmp;

If you find this script useful please donate generously.

Split SSRS XML into chunks and store it as temporary table records

Use case is known T-SQL limitation: The pattern to be searched and replaced can't exceed the maximum possible size: 8000 bytes, or 4000 Unicode characters. This applies to intrinsic functions REPLACE, CHARINDEX, PATINDEX and LIKE.

One way around is search XML using Xpath.

However, the stored procedure below performs the following:

1.       Starts at the beginning of the XML and reads 4000 characters. At this point it reads backwards to the last closed tag and stores that position e.g. may be at 3982 characters. It then stores this as the first “chunk” of XML.

2.       Then it continues to read the next 4000 characters from the last end position (e.g. was 3982 so would read from 3983), and at this point reads backwards again to get the next “chunk”.

3.       This process repeats until you reach the end of the XML then this allows us to read through each chunk using intrinsic T-SQL functions.

Note that this process works correctly providing all data sources within XML are no longer than the possible maximum size.  Best practice is to reside all data sources as database objects (Views, User Defined Functions or Stored Procedures).

USE ReportServer;
GO

SET ANSI_NULLS ON
GO

SET QUOTED_IDENTIFIER ON
GO

SET ANSI_WARNINGS  OFF
GO

PRINT 'Date: ' + CONVERT(VARCHAR(24),GETDATE(),13) + '   Server Name: ' + @@servername + '   Service Name: ' + @@servicename
GO

IF EXISTS
      (SELECT *
          FROM sys.objects
          WHERE name = 'SplitXMLToTableRecords')
    drop procedure YourSchema.SplitXMLToTableRecords
    PRINT 'drop procedure YourSchema.SplitXMLToTableRecords'
GO

PRINT 'CREATE PROCEDURE YourSchema.SplitXMLToTableRecords'
GO
CREATE PROCYourSchema.SplitXMLToTableRecords @Path NVARCHAR(425)
AS
    BEGIN
        BEGIN TRY
            DECLARE @reportXML NVARCHAR(MAX)
            ,       @strXML    NVARCHAR(4000)
            ,       @lenXML    INT
            ,       @index     INT
            ,       @posXML    INT
            ,       @loopsXML  NUMERIC(10,2);

            IF OBJECT_ID('tempdb..#tblXML') IS NOT NULL
                DROP TABLE #tblXML;
            CREATE TABLE #tblXML ( indXML INT
            ,                       [Path] NVARCHAR(425)
            ,                      strXML NVARCHAR(4000)
            ,                      lenXML INT );

            SELECT @reportXML = CAST(CONVERT(XML,CONVERT(VARBINARY(MAX),Content)) AS NVARCHAR(MAX))
            FROM ReportServer.dbo.Catalog
            WHERE [Path] LIKE @path;

            SET @loopsXML = CEILING((SELECT LEN(CAST(@reportXML AS NVARCHAR(MAX))))/CAST(4000 AS NUMERIC));
            SET @index = 0;
            SET @posXML = 1;

            WHILE (1 = 1) BEGIN
                SELECT @lenXML = LEN(SUBSTRING(CAST(@reportXML AS NVARCHAR(MAX)),@posXML,4001 - charindex('>',reverse(SUBSTRING(CAST(@reportXML AS NVARCHAR(MAX)),@posXML,4000))) - charindex('>',reverse(SUBSTRING(CAST(@reportXML AS NVARCHAR(MAX)),@posXML,4000 - charindex('>',reverse(SUBSTRING(CAST(@reportXML AS NVARCHAR(MAX)),@posXML,4000))))))));
                IF @lenXML <> 0    BEGIN
                    SET @index = @index + 1;
                    SET @strXML = (SELECT SUBSTRING(CAST(@reportXML AS NVARCHAR(MAX)),@posXML,4001 - charindex('>',reverse(SUBSTRING(CAST(@reportXML AS NVARCHAR(MAX)),@posXML,4000))) - charindex('>',reverse(SUBSTRING(CAST(@reportXML AS NVARCHAR(MAX)),@posXML,4000 - charindex('>',reverse(SUBSTRING(CAST(@reportXML AS NVARCHAR(MAX)),@posXML,4000))))))));
                    SET @lenXML = LEN(@strXML);
                    INSERT INTO #tblXML (    indXML
                    ,                        [Path]
                    ,                        strXML
                    ,                        lenXML)
                    VALUES (                 @index
                    ,                        @Path
                    ,                        @strXML
                    ,                        @lenXML
                    );

                    SET @reportXML = SUBSTRING(CAST(@reportXML AS NVARCHAR(MAX)),@posXML,LEN(CAST(@reportXML AS NVARCHAR(MAX))));
                    SET @posXML = @lenXML + 1;
                    IF @loopsXML = @index BREAK;
                END;
            END;
            SELECT *
            FROM #tblXML;
        END TRY
            BEGIN CATCH
                SELECT   ERROR_NUMBER() AS ErrorNumber 
                        ,ERROR_SEVERITY() AS ErrorSeverity 
                        ,ERROR_STATE() AS ErrorState 
                        ,ERROR_PROCEDURE() AS ErrorProcedure 
                        ,ERROR_LINE() AS ErrorLine 
                        ,ERROR_MESSAGE() AS ErrorMessage; 
            END CATCH;
    END;
/************************************************************************************************************************************
Test:

    IF OBJECT_ID('tempdb..#myXML') IS NOT NULL    DROP TABLE #myXML;
        CREATE TABLE #myXML ( indXML INT
        ,                      strXML NVARCHAR(4000)
        ,                      lenXML INT );

    INSERT INTO #myXML
            ( indXML, strXML, lenXML )
    EXEC ReportServer.YourSchema.SplitXMLToTableRecords 'YourPath';

    SELECT *
    FROM #myXML;

*************************************************************************************************************************************/
GO

If you find this script useful please donate generously.