default

S Teck Top Tech Tips Episode II: Sneckdowns in Mining

For my more latitudinally northern colleagues and friends, the unfortunate truth is that the first snows of the year are coming our way sooner rather than later. But do not despair, there are some great opportunities hidden within those snowbanks!

Today I’m talking about “sneckdowns” – (S-Teckdowns? ®) which is a portemanteau of snowy and neckdowns. Neckdowns are a technical term for curb extensions, or the unused space on a roadway. Sneckdowns are the unused space on a trafficked area delineated by snowfall. I was inspired by a very interesting article on the always insightful 99% Invisible podcast website. The link can be found here: https://99percentinvisible.org/article/undriven-snow-activists-trace-winter-car-routes-reshape-city-streets/

I think there are opportunities to better understand our trafficked space on our haul roads and integrate this information into a georeferenced drone survey to really do some engineering work on it! Check out the video below to learn more!

As always, I would love to hear your thoughts and if you’re planning to try this out at your minesite this winter!

1465600675_188117518

S Teck Top Tech Tips Episode 1: VBA Integrated Questionnaire for Short-Range Planning

This VBA questionnaire and integrated email ensures that the plans and reports sent out are consistent and the information has been checked. It can easily be modified to suit any application. I hope you find it useful, and please leave a comment if you implement this in your work!

I’m sharing the Excel file (you will need to re-enable macros for it to work) and also further down you can copy the VBA code directly into your own macros for use and modification.

Download Zip file below for the Excel file:

Download

The “Send Draft Email” macro is as follows: 

 
Sub Draft_Email()
Dim Msg, Style, Title, Help, Ctxt, Response, MyString, dtToday As Date
    Dim OutApp As Object
    Dim Outmail As Object
    Dim strbody As String
    Dim MakeJPG As String
    Dim Signature As String
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
dtToday = Date
'Series of questions to validate plan
'Question 1.
Msg = "Are there any upcoming weather events?"    ' Define message.
Style = vbYesNoCancel ' Define buttons.
Title = "Grader Plan Check"    ' Define title.
Help = "DEMO.HLP"    ' Define Help file.
Ctxt = 1000    ' Define topic context.
        ' Display message.
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then    ' User chose Yes.
    MyString = "Yes"    ' Perform some action.
ElseIf Response = vbNo Then   ' User chose No.
    MyString = "No"    ' Perform some action.
ElseIf Response = vbCancel Then
    Exit Sub
End If
'Question 2.
Msg = "Do the planned tonnes match the daily mining plan?"    ' Define message.
Style = vbYesNoCancel ' Define buttons.
Title = "Grader Plan Check"    ' Define title.
Help = "DEMO.HLP"    ' Define Help file.
Ctxt = 1000    ' Define topic context.
        ' Display message.
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then    ' User chose Yes.
    MyString = "Yes"    ' Perform some action.
ElseIf Response = vbNo Then   ' User chose No.
    MyString = "No"    ' Perform some action.
ElseIf Response = vbCancel Then
    Exit Sub
End If
'Question 3.
Msg = "Is Fleet NOH >= Planned Required NOH?"    ' Define message.
Style = vbYesNoCancel ' Define buttons.
Title = "Grader Plan Check"    ' Define title.
Help = "DEMO.HLP"    ' Define Help file.
Ctxt = 1000    ' Define topic context.
        ' Display message.
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then    ' User chose Yes.
    MyString = "Yes"    ' Perform some action.
ElseIf Response = vbNo Then   ' User chose No.
    MyString = "No"    ' Perform some action.
ElseIf Response = vbCancel Then
    Exit Sub
End If
'This section generates the email
    Dim rngToPicture As Range
    Dim outlookApp As Object
    Dim strTempFilePath As String
    Dim strTempFileName As String
    Dim strTo As String
    Dim strSubject As String
    Const olMailItem = 0
    Const olByValue = 1
    
    'Name it anything, doesn't matter
    strTempFileName = "RangeAsPNG"
    'rngToPicture is defined as NAMED RANGE in the workbook, do modify this name before use
    Set rngToPicture = Range("rngToPicture")
    Set outlookApp = CreateObject("Outlook.Application")
    Set Outmail = outlookApp.CreateItem(olMailItem)
    'Create an email
    strbody = "Hello Team," & "<br><br>" & _
        "Please review daily grading plan below and provide feedback." & "<br>" & _
        "If you need more information let me know." & "<br><br>" & _
        "Regards Short Range Planning Team <br><br>"
        
    With Outmail
        .To = ""
        .CC = ""
        .Subject = "Grader Daily Plan " & dtToday
        'Create the range as a PNG file and store it in temp folder
        Call createPNG(rngToPicture, strTempFileName)
        'Embed the image in Outlook
        strTempFilePath = Environ$("temp") & "\" & strTempFileName & ".png"
        '.Attachments.Add strTempFilePath, 1, 0
        'Change the HTML below to add Header (Dear John) or signature (Kind Regards) using newline tag (<br />)
        .HTMLBody = "<html><p>" & strbody & "<img src= '" & strTempFilePath & "' style='border:0'>"
        'replace with .Send if you want to send email without viewing first.
        .Display
        
    End With
    Set Outmail = Nothing
    Set outlookApp = Nothing
    Set rngToPicture = Nothing
End Sub
     
'This sub creates the image which is then embedded in the email
     
Sub createPNG(ByRef rngToPicture As Range, nameFile As String)
    Dim wksName As String
    wksName = rngToPicture.Parent.Name
    'Delete the existing PNG file of same name, if exists
    On Error Resume Next
       Kill Environ$("temp") & "\" & nameFile & ".png"
    On Error GoTo 0
    'Copy the range as picture
    rngToPicture.CopyPicture
    'Paste the picture in Chart area of same dimensions
    With ThisWorkbook.Worksheets(wksName).ChartObjects.Add(rngToPicture.Left, rngToPicture.Top, rngToPicture.Width, rngToPicture.Height)
        .Activate
        .Chart.Paste
        'Export the chart as PNG File to Temp folder
        .Chart.Export Environ$("temp") & "\" & nameFile & ".png", "PNG"
    End With
    Worksheets(wksName).ChartObjects(Worksheets(wksName).ChartObjects.Count).Delete
End Sub

The “Draft Email VBA Code with random generator” macro is as follows: 

Sub DraftRandomQuotes_Click()

Dim Msg, Style, Title, Help, Ctxt, Response, MyString, dtToday As Date


    Dim OutApp As Object
    Dim Outmail As Object
    Dim strbody As String
    Dim MakeJPG As String
    Dim Signature As String

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    'this assigns today's value for the date when sending out the email with a date field
    dtToday = Date


'Series of questions to validate plan

'Question 1.
Msg = "Are there any upcoming weather events?"    ' Define message.
Style = vbYesNoCancel ' Define buttons.
Title = "Grader Plan Check"    ' Define title.
Help = "DEMO.HLP"    ' Define Help file.
Ctxt = 1000    ' Define topic context.
        ' Display message.
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then    ' User chose Yes.
    MyString = "Yes"    ' Perform some action.
ElseIf Response = vbNo Then   ' User chose No.
    MyString = "No"    ' Perform some action.
ElseIf Response = vbCancel Then
    Exit Sub
End If

'Question 2.
Msg = "Do the planned tonnes match the daily mining plan?"    ' Define message.
Style = vbYesNoCancel ' Define buttons.
Title = "Grader Plan Check"    ' Define title.
Help = "DEMO.HLP"    ' Define Help file.
Ctxt = 1000    ' Define topic context.
        ' Display message.
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then    ' User chose Yes.
    MyString = "Yes"    ' Perform some action.
ElseIf Response = vbNo Then   ' User chose No.
    MyString = "No"    ' Perform some action.
ElseIf Response = vbCancel Then
    Exit Sub
End If

'Question 3.
Msg = "Is Fleet NOH >= Planned Required NOH?"    ' Define message.
Style = vbYesNoCancel ' Define buttons.
Title = "Grader Plan Check"    ' Define title.
Help = "DEMO.HLP"    ' Define Help file.
Ctxt = 1000    ' Define topic context.
        ' Display message.
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then    ' User chose Yes.
    MyString = "Yes"    ' Perform some action.
ElseIf Response = vbNo Then   ' User chose No.
    MyString = "No"    ' Perform some action.
ElseIf Response = vbCancel Then
    Exit Sub
End If

'You can keep copying the format above to add more questions

'Bonus section- random quote generator, makes you look forward to generating the plan!

Dim strQuotes(4) As String
Dim lngIndex As Long

strQuotes(0) = "Mines are what happens while you're making other plans" & vbNewLine & "-Andreas Steckenborn"
strQuotes(1) = "Never rest on your ores" & vbNewLine & "-Norman B. Keevil"
strQuotes(2) = "Plans are of little importance, but planning is essential" & vbNewLine & "-Eisenhower"
strQuotes(3) = "...Insert shameless plug for S-Teck Mining Consulting Ltd. here..."
strQuotes(4) = "Be not simply good- be good for something" & vbNewLine & " -Thoreau"

lngIndex = Int((4 - 0 + 1) * Rnd + 0)

MsgBox strQuotes(lngIndex)

'This section generates the email

    Dim rngToPicture As Range
    Dim outlookApp As Object
    Dim strTempFilePath As String
    Dim strTempFileName As String
    Dim strTo As String
    Dim strSubject As String
    Const olMailItem = 0
    Const olByValue = 1
    
    'Name it anything, doesn't matter
    strTempFileName = "RangeAsPNG"

    'rngToPicture is defined as NAMED RANGE in the workbook, do modify this name before use
    Set rngToPicture = Range("rngToPicture")
    Set outlookApp = CreateObject("Outlook.Application")
    Set Outmail = outlookApp.CreateItem(olMailItem)

    'Create an email
    strbody = "Hello Team," & "<br><br>" & _
        "Please review daily grading plan below and provide feedback." & "<br>" & _
        "If you need more information let me know." & "<br><br>" & _
        "Regards Short Range Planning Team <br><br>"
        
    With Outmail
        .To = ""
        .CC = ""
        .Subject = "Grader Daily Plan " & dtToday

        'Create the range as a PNG file and store it in temp folder
        Call createPNG(rngToPicture, strTempFileName)

        'Embed the image in Outlook
        strTempFilePath = Environ$("temp") & "\" & strTempFileName & ".png"
        '.Attachments.Add strTempFilePath, 1, 0

        'Change the HTML below to add Header (Dear John) or signature (Kind Regards) using newline tag (<br />)
        .HTMLBody = "<html><p>" & strbody & "<img src= '" & strTempFilePath & "' style='border:0'>"
        .Display

    End With

    Set Outmail = Nothing
    Set outlookApp = Nothing
    Set rngToPicture = Nothing

End Sub
     
'This sub creates the image which is then embedded in the email
     
Sub createPNG(ByRef rngToPicture As Range, nameFile As String)

    Dim wksName As String

    wksName = rngToPicture.Parent.Name

    'Delete the existing PNG file of same name, if exists
    On Error Resume Next
       Kill Environ$("temp") & "\" & nameFile & ".png"
    On Error GoTo 0

    'Copy the range as picture
    rngToPicture.CopyPicture

    'Paste the picture in Chart area of same dimensions
    With ThisWorkbook.Worksheets(wksName).ChartObjects.Add(rngToPicture.Left, rngToPicture.Top, rngToPicture.Width, rngToPicture.Height)
        .Activate
        .Chart.Paste
        'Export the chart as PNG File to Temp folder
        .Chart.Export Environ$("temp") & "\" & nameFile & ".png", "PNG"
    End With
    Worksheets(wksName).ChartObjects(Worksheets(wksName).ChartObjects.Count).Delete


End Sub