Visual Studio Attach Security Warning

I got a new work machine today. Setting a new dev machine up is a pain and usually takes me the better part of a month to get it configured where I am happy – yeah, I have a touch of the OCD. Here is one of the first annoyances I had to deal with – Visual Studio’s Attach Security Warning :

Attaching to this process can potentially harm your computer.
If the information below looks suspicious or you are unsure, do not attach to this process.

Attach Security Warning

Make sure Visual Studio is not running, then modify your registry :

HKCUSoftwareMicrosoftVisualStudio[Version Number]Debugger
Change the DWord value of DisableAttachSecurityWarning to 1.

One annoyance down, a hundred more to go 😉

VBA File Operations Class

This is a start of a VBA file operations class. Currently it can be used to detect if a file exists, and return file times – date last accessed, date created, date last modified.

I will be extending the class over time. Add a comment if there is something in particular you would like to see included.

Private Const m_sSource As String = "clsFileOps"

Private Const GENERIC_READ As Long = &H80000000
Private Const FILE_SHARE_READ As Long = &H1
Private Const OPEN_EXISTING As Long = 3
Private Const FILE_FLAG_BACKUP_SEMANTICS = &H2000000
Private Const INVALID_HANDLE_VALUE As Long = -1

#If vba7 And win64 Then
    Private Declare PtrSafe Function CreateFile Lib "kernel32.dll" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
    Private Declare PtrSafe Function GetFileTime Lib "kernel32" (ByVal hFile As Long, lpCreationTime As FILETIME, lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME) As Long
    Private Declare PtrSafe Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long
    Private Declare PtrSafe Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
    Private Declare PtrSafe Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
#Else
    Private Declare Function CreateFile Lib "kernel32.dll" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
    Private Declare Function GetFileTime Lib "kernel32" (ByVal hFile As Long, lpCreationTime As FILETIME, lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME) As Long
    Private Declare Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long
    Private Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
    Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
#End If

Private Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End Type

Private Type SYSTEMTIME
        wYear As Integer
        wMonth As Integer
        wDayOfWeek As Integer
        wDay As Integer
        wHour As Integer
        wMinute As Integer
        wSecond As Integer
        wMilliseconds As Integer
End Type

Private m_sFilePath As String
Private m_dLastModified As Date
Private m_dLastAccesed As Date
Private m_dCreate As Date
Private m_hFile As Long

'----- Class Events
Private Sub Class_Terminate()
    CloseFileHandle
End Sub
'----- Class Events

'----- Public Members
Public Property Let FilePath(ByVal NewValue As String)
    m_sFilePath = NewValue
    If Not FileExists(NewValue) Then Err.Raise vbObjectError + 1, m_sSource, NewValue & " does not exist"
    InitFileTimes
End Property
Public Property Get LastModified() As Date
    LastModified = m_dLastModified
End Property
Public Property Get Created() As Date
    Created = m_dCreate
End Property
Public Property Get LastAccessed() As Date
    LastAccessed = m_dLastAccesed
End Property
Public Property Get FileExists(ByVal Path As String) As Boolean
    On Error GoTo exit_here
    FileExists = ((GetAttr(Path) And vbDirectory) = vbDirectory) = 0

exit_here:
End Property
'----- Public Members

'----- Private Members
Private Sub CloseFileHandle()
    Dim lR As Long

    If (m_hFile > 0) Then
        lR = CloseHandle(m_hFile)
        If (lR = 0) Then Err.Raise vbObjectError + 1, m_sSource, "Error closing file handle"
        m_hFile = 0
    End If
End Sub
Private Sub InitFileTimes()
    Dim tFT_Local As FILETIME
    Dim tST As SYSTEMTIME
    Dim tFT_Modified As FILETIME
    Dim tFT_Created As FILETIME
    Dim tFT_Accessed As FILETIME
    Dim tFT As FILETIME

    CloseFileHandle

    m_hFile = CreateFile(m_sFilePath, _
                         GENERIC_READ, _
                         FILE_SHARE_READ, _
                         0&, _
                         OPEN_EXISTING, _
                         FILE_FLAG_BACKUP_SEMANTICS, _
                         0&)

    If (m_hFile = INVALID_HANDLE_VALUE) Then
        Err.Raise vbObjectError + 1, m_sSource, "Invalid file"
    Else
        If (GetFileTime(m_hFile, tFT_Created, tFT_Accessed, tFT_Modified) = 1) Then
            If FileTimeToLocalFileTime(tFT_Created, tFT_Local) Then
                If FileTimeToSystemTime(tFT_Local, tST) Then
                    m_dCreate = DateSerial(tST.wYear, tST.wMonth, tST.wDay) + TimeSerial(tST.wHour, tST.wMinute, tST.wSecond)
                Else
                    Err.Raise vbObjectError + 2, m_sSource, "Filetime to system time error"
                End If
            Else
                Err.Raise vbObjectError + 3, m_sSource, "Filetime to local filetime error"
            End If

            If FileTimeToLocalFileTime(tFT_Accessed, tFT_Local) Then
                If FileTimeToSystemTime(tFT_Local, tST) Then
                    m_dLastAccesed = DateSerial(tST.wYear, tST.wMonth, tST.wDay) + TimeSerial(tST.wHour, tST.wMinute, tST.wSecond)
                Else
                    Err.Raise vbObjectError + 4, m_sSource, "Filetime to system time error"
                End If
            Else
                Err.Raise vbObjectError + 5, m_sSource, "Filetime to local filetime error"
            End If

            If FileTimeToLocalFileTime(tFT_Modified, tFT_Local) Then
                If FileTimeToSystemTime(tFT_Local, tST) Then
                    m_dLastModified = DateSerial(tST.wYear, tST.wMonth, tST.wDay) + TimeSerial(tST.wHour, tST.wMinute, tST.wSecond)
                Else
                    Err.Raise vbObjectError + 6, m_sSource, "Filetime to system time error"
                End If
            Else
                Err.Raise vbObjectError + 7, m_sSource, "Filetime to local filetime error"
            End If
        Else
            Err.Raise vbObjectError + 8, m_sSource, "Error getting file time"
        End If
    End If
End Sub
'----- Private Members

Example Usage :

Public Sub UnitTest()
    Const sFilePath As String = "C:$WIPPDF File.pdf"
    Dim cF As clsFileOps
    Dim dt As Date

    Set cF = New clsFileOps

    If cF.FileExists(sFilePath) Then
        cF.FilePath = "C:$WIPPDF File.pdf"
        dt = cF.Created
        dt = cF.LastAccessed
        dt = cF.LastModified
    End If
End Sub

Open Websites, Files and Generate Emails Using VBA

Typically you can launch files, webpages, and generate emails using Excel’s FollowHyperlink method (I think the same method is available in all Office products).

For some reason I was getting nasty Excel crashes using it recently, so I switched to using a Windows API alternative.

Private Const m_sSource As String = "modShell"

'http://msdn.microsoft.com/en-us/library/windows/desktop/bb762153(v=vs.85).aspx
Private Const SHELL_ERROR = 32  'If the function succeeds, it returns a value greater than 32

#If win64 Then
    Private Declare PtrSafe Function ShellExecuteA Lib "shell32.dll" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
#Else
    Private Declare Function ShellExecuteA Lib "shell32.dll" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
#End If

Public Function GenerateEmail(ByVal SendTo As String, _
                              ByVal Subject As String, _
                              ByVal Body As String, _
                              Optional ByVal CC As String = vbNullString) As Boolean

    Dim sPath As String

    sPath = "mailto:" & SendTo
    If Len(CC) > 0 Then
        sPath = sPath & "?cc=" & CC
        sPath = sPath & "&subject=" & Subject
    Else
        sPath = sPath & "?subject=" & Subject
    End If
    sPath = sPath & "&body=" & Replace(Body, vbCrLf, "%0D%0A")

    GenerateEmail = ShellExecute(sPath)
End Function
Public Function ShellExecute(ByVal Path As String, _
                             Optional ByVal sParameters As String, _
                             Optional ByVal WindowStyle As VbAppWinStyle = vbNormalFocus) As Boolean

    ShellExecute = (ShellExecuteA(0, _
                                 "Open", _
                                 Path, _
                                 sParameters, _
                                 vbNullString, _
                                 WindowStyle) > SHELL_ERROR)
End Function

Example Usage:

Public Sub UnitTest1() 'Create an Email in client
    Dim sTo As String
    Dim sSubject As String
    Dim sBody As String
    Dim bR As Boolean

    sTo = "foo@bar.com"
    sSubject = "This is the subject"
    sBody = "This is the body"

    bR = GenerateEmail(sTo, sSubject, sBody)
End Sub
Public Sub UnitTest2()  'Launch a File
    Dim bR As Boolean

    bR = ShellExecute("c:$WIPPDF File.pdf")
End Sub
Public Sub UnitTest3()  'Launch a Webpage
    Dim bR As Boolean

    bR = ShellExecute("http://shutupdean.com/")
End Sub