Building a respectable VBA with Excel Application

VBA with Excel is not the right tool/language to solve mankind’s perennial question regarding the purpose of life. But it can come quite handy for several tasks for e.g. in quickly creating a Proof of Concept (PoC) or a prototype. It can also be quite useful for smaller tasks for e.g. 3G networks dimensioning, determining an investment portfolio, insurance schemes or maybe a smaller version of a Windows Resource Management tool. To take a quick look at how put together a VBA application quickly take a look at my earlier post “Stir fry a VBA with Excel application quickly”. This post takes a look at some key aspects in building a respectable, decent tool. Some of essential elements are as follows a) Launch button: Launch the application from the Excel sheet. For this you could add a button to the Excel sheet. For this select “View->Toolbars-Forms”. From the toolbar select a button and place it in the Excel sheet. Once you place the button appropriately select the button and choose the “Edit code” from the Forms toolbox. Add the following code Sub Button1_Click () UserForm1.Show End Sub The Userform1 is the form that you created with VBA toolbox.

b) Minimize button Now that you are able to launch the VBA application from the Excel spreadsheet you will also want to minimize the VBA form to check the output on the Excel sheet. For this add a button to the Userform probably “_” the icon for minimizing and add Private Sub CommandButton13_Click() Unload UserForm1 End Sub You could also do a Userform1. Hide but I found that once you did that and re-launched the application the combo-box’s list started to repeat. Unload essentially resets the Form and that was fine with me. c) Getting control of the Excel sheet: This is extremely important. Make sure that in the properties window of your userform you have ShowModal set as “false”. This will allow you to edit/change your Excel sheet even when the VBA application is running. d) Status Control: VBA does provide a “Status” control in the additional controls for the Userform toolbox. But I could not get it to work. So I added a textbox and update the text box with “Working …” and “Done.” e) Progress bar: If you want to add a progress bar do so by adding this control. For this right-click in the toolbox and choose additional controls. I did not have the need to use this but a good write up is available at O’Reilly Hacks This is the userform I created

Option Explicit
Dim servername
Dim row
Dim value

Private Sub CommandButton13_Click()
Unload UserForm1
End Sub
Private Sub CommandButton14_Click()
Unload UserForm1
End Sub

Private Sub CommandButton2_Click()
ComboBox1.ListIndex = 0
Me.OptionButton1.value = True
TextBox1.value = ""
End Sub

Private Sub CommandButton3_Click()
Unload UserForm1
End Sub

Private Sub TextBox1_Change()
servername = TextBox1.value
End Sub
Private Sub UserForm_Activate()
With ComboBox1
    ComboBox1.AddItem "Physical Memory Properties"
    ComboBox1.AddItem "Get Server Info"
    ...
    ....
    End With
Me.Label17.Font.Bold = True
Me.MultiPage1.ForeColor = vbBlue
ComboBox1.ListIndex = 0
Me.OptionButton1.value = True
row = 25
End Sub
Private Sub ComboBox1_Click()
Dim x
Select Case ComboBox1.Text
   Case "Physical Memory Properties"
        value = 1
   Case "Get Server Info"
        value = 2
   ...
   ...        
End Select

End Sub
Private Sub CommandButton1_Click()

If OptionButton1.value = True Then

Select Case value
   Case 1
        Call phy_mem_prop
   Case 2
        Call GetServerInfo
   ...
   ...          
End Select
Else
  If OptionButton2.value = True Then
     
    Select Case value
    Case 1
        Call phy_mem_prop_csv
    Case 2

        Call GetServerInfo_csv
  ...
  ...          
    End Select
    End If
 

End If
End Sub

Private Sub phy_mem_prop()
On Error Resume Next
Dim strComputer, i, objWMIService, strMemory, colItems
Dim strCapacity, objItem, installedModules, totalSlots
Dim strCapacityGB
Dim r As Range
Dim arrstring
Dim slogFile, objFs, objFile
Dim col
row = row + 3

arrstring = Split(servername, ",")
For Each strComputer In arrstring
i = 1
Application.StatusBar = "Working..."
UserForm1.TextBox5.Font.Italic = True
UserForm1.TextBox5.Font.Bold = False
UserForm1.TextBox5.Font.Size = 10
UserForm1.TextBox5 = "Working..."

Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_PhysicalMemory")

For Each objItem In colItems
    strCapacity = objItem.Capacity
    If strMemory <> "" Then strMemory = strMemory & vbCrLf
    strMemory = strMemory & "Bank" & i & " : " & (objItem.Capacity / 1048576) & " Mb"
    i = i + 1
Next
installedModules = i - 1

Set colItems = objWMIService.ExecQuery("Select * from Win32_PhysicalMemoryArray")
For Each objItem In colItems
    totalSlots = objItem.MemoryDevices
    strCapacity = (objItem.MaxCapacity / 1024)
    strCapacityGB = strCapacity / 1024
Next
'MsgBox "Total Slots: " & totalSlots & vbCrLf & _
         "Free Slots: " & (totalSlots - installedModules) & vbCrLf & _
         vbCrLf & "Installed Modules:" & vbCrLf & strMemory & vbCrLf & vbCrLf & _
         "Maximum Capacity for " & strComputer & ": " & strCapacityGB & " GB", vbOKOnly + vbInformation, "PC Memory Information"

Sheet1.Cells(row, 1).Font.Bold = True
Cells(row, 1) = "Physical Memory Properties"
row = row + 1

For col = 1 To 5
  Sheet1.Cells(row, col).Interior.Color = vbCyan
  Sheet1.Cells(row, col).Font.Bold = True
Next

Cells(row, 1) = "Computer Name: "
Cells(row, 2) = "Total Slots"
Cells(row, 3) = "Free Slots"
Cells(row, 4) = "Installed Modules"
Cells(row, 5) = "Maximum Capacity for"
row = row + 1
Cells(row, 1) = strComputer
Cells(row, 2) = totalSlots
Cells(row, 3) = totalSlots - installedModules
Cells(row, 4) = strMemory
Cells(row, 5) = strCapacityGB
Next
UserForm1.TextBox5.Font.Italic = False
UserForm1.TextBox5 = "Done."
Application.StatusBar = "Done."
Application.StatusBar = False
End Sub

Private Sub phy_mem_prop_csv()
On Error Resume Next
Dim arrstring
Dim strComputer, i, objWMIService, strMemory, colItems
Dim strCapacity, objItem, installedModules, totalSlots
Dim strCapacityGB
Const FOR_APPEND = 8
Dim slogFile
Dim objFs, objFile
arrstring = Split(servername, ",")
For Each strComputer In arrstring
i = 1

Application.StatusBar = "Working..."
UserForm1.TextBox5.Font.Italic = True
UserForm1.TextBox5.Font.Bold = False
UserForm1.TextBox5.Font.Size = 10
UserForm1.TextBox5 = "Working..."

Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_PhysicalMemory")
For Each objItem In colItems
    strCapacity = objItem.Capacity
    If strMemory <> "" Then strMemory = strMemory & vbCrLf
    strMemory = strMemory & "Bank" & i & " : " & (objItem.Capacity / 1048576) & " Mb"
    i = i + 1
Next
installedModules = i - 1

Set colItems = objWMIService.ExecQuery("Select * from Win32_PhysicalMemoryArray")

For Each objItem In colItems
    totalSlots = objItem.MemoryDevices
    strCapacity = (objItem.MaxCapacity / 1024)
    strCapacityGB = strCapacity / 1024
Next

slogFile = "logfile.txt"
Set objFs = CreateObject("scripting.FileSystemObject")
Set objFile = objFs.OpenTextFile(slogFile, FOR_APPEND, True)
objFile.writeline
objFile.writeline
objFile.writeline
objFile.writeline
objFile.writeline

objFile.writeline "Physical Memory Properties"
    objFile.writeline "Total slot = " & totalSlots & _
     "Free Slots = " & totalSlots - installedModules & _
         "Installed Modules = " & strMemory + _
         "Max capacity = " & strCapacityGB

         objFile.Close
         Set objFile = Nothing
         Set objFs = Nothing
  Next

UserForm1.TextBox5.Font.Italic = False
UserForm1.TextBox5 = "Done."
UserForm1.TextBox5 = "Output in logfile.txt"
Application.StatusBar = "Done."
Application.StatusBar = False
End Sub
Sub GetServerInfo()
On Error Resume Next

Dim r As Range, i As Integer, N As Integer
Dim arrstring
Dim strComputer, colDisks, objDisk, objWMIService
Dim col
row = row + 3
Application.StatusBar = "Working..."
UserForm1.TextBox5.Font.Italic = True
UserForm1.TextBox5.Font.Bold = False
UserForm1.TextBox5.Font.Size = 10
UserForm1.TextBox5 = "Working..."

arrstring = Split(servername, ",")
For Each strComputer In arrstring


Worksheets("sheet1").Activate
Set objWMIService = GetObject _
    ("winmgmts:\\" & strComputer & "\root\cimv2")
Set colDisks = objWMIService.ExecQuery _
         ("Select * From Win32_LogicalDisk")
     
Sheet1.Cells(row, 1).Font.Bold = True
Cells(row, 1) = "Server Information"
row = row + 1

For col = 1 To 4
  Sheet1.Cells(row, col).Interior.Color = vbCyan
  Sheet1.Cells(row, col).Font.Bold = True
Next
Cells(row, 1) = "Computer Name: "
         Cells(row, 2) = "Disk"
         Cells(row, 3) = "Free Space"
         Cells(row, 4) = "Total Size"
                  row = row + 1
Cells(row, 1) = strComputer
         For Each objDisk In colDisks
                        Cells(row, 2) = objDisk.DeviceID
             If objDisk.FreeSpace < 1073741824 Then
                                        Cells(row, 3) = objDisk.FreeSpace / 1024 / 1024
                            Else
                   
                     Cells(row, 3) = objDisk.FreeSpace / 1024 / 1024
            End If
            Cells(row, 4) = objDisk.Size / 1024 / 1024
            row = row + 1
                    Next
Next
UserForm1.TextBox5.Font.Italic = False
UserForm1.TextBox5 = "Done."
Application.StatusBar = "Done."
Application.StatusBar = False
End Sub

Sub GetServerInfo_csv()
On Error Resume Next

Dim arrstring
Dim strComputer, colDisks, objDisk, objWMIService
Dim slogFile
Dim objFs, objFile
Const FOR_APPEND = 8
arrstring = Split(servername, ",")
For Each strComputer In arrstring
Application.StatusBar = "Working..."
UserForm1.TextBox5.Font.Italic = True
UserForm1.TextBox5.Font.Bold = False
UserForm1.TextBox5.Font.Size = 10
UserForm1.TextBox5 = "Working..."
Set objWMIService = GetObject _
    ("winmgmts:\\" & strComputer & "\root\cimv2")
Set colDisks = objWMIService.ExecQuery _
         ("Select * From Win32_LogicalDisk")
slogFile = "logfile.txt"
Set objFs = CreateObject("scripting.FileSystemObject")
Set objFile = objFs.OpenTextFile(slogFile, FOR_APPEND, True)
objFile.writeline
objFile.writeline
objFile.writeline
objFile.writeline
objFile.writeline
objFile.writeline "Server Information"
objFile.writeline "Computer Name: ,Disk, Free Space, Total Size"
 objFile.write strComputer & ","
         For Each objDisk In colDisks
               objFile.write objDisk.DeviceID & ","
             If objDisk.FreeSpace < 1073741824 Then
                   objFile.write objDisk.FreeSpace / 1024 / 1024 & ","
                            Else
                 
                     objFile.write objDisk.FreeSpace / 1024 / 1024 & ","
            End If
            objFile.writeline objDisk.Size / 1024 / 1024 & ","
                   
          Next
          Next
          objFile.Close
         Set objFile = Nothing
         Set objFs = Nothing
       
UserForm1.TextBox5.Font.Italic = False
UserForm1.TextBox5 = "Done."
UserForm1.TextBox5 = "Output in logfile.txt"
Application.StatusBar = "Done."
Application.StatusBar = False
       
End Sub

Sub GetService()
On Error Resume Next
Dim strstring
Dim r As Range, i As Integer, N As Integer
Dim col
Dim arrstring
Dim strComputer, colWMIThings, objItem, objWMIService
row = row + 4
Application.StatusBar = "Working..."
UserForm1.TextBox5.Font.Italic = True
UserForm1.TextBox5.Font.Bold = False
UserForm1.TextBox5.Font.Size = 10
UserForm1.TextBox5 = "Working..."
arrstring = Split(servername, ",")
For Each strComputer In arrstring
'MsgBox (servername)
Worksheets("sheet1").Activate
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colWMIThings = _
    objWMIService.ExecQuery("SELECT * FROM Win32_service")
Sheet1.Cells(row, 1).Font.Bold = True
Cells(row, 1) = "Services"
row = row + 1
For col = 1 To 4
  Sheet1.Cells(row, col).Interior.Color = vbCyan
  Sheet1.Cells(row, col).Font.Bold = True
Next
Cells(row, 1) = "Computer Name: "
Cells(row, 2) = "Service name"
Cells(row, 3) = "Status"
Cells(row, 4) = "Strtup Mode"
row = row + 1
Cells(row, 1) = strComputer
    For Each objItem In colWMIThings
                If objItem.State = "Stopped" And objItem.StartMode = "Auto" Then
            Cells(row, 2) = objItem.DisplayName
        Else
            Cells(row, 2) = objItem.DisplayName
        End If
        Cells(row, 3) = objItem.State
        Cells(row, 4) = objItem.StartMode
        row = row + 1
    Next
    Next
UserForm1.TextBox5.Font.Italic = False
UserForm1.TextBox5 = "Done."
Application.StatusBar = "Done."
Application.StatusBar = False
End Sub