Public Function ConvertBinaryToOctal(BinVal As String) As String
Dim i%, Length%
Select Case (Len(BinVal) Mod 3)
    Case 1:
        BinVal = "00" + BinVal
    Case 2:
        BinVal = "0" + BinVal
End Select
Length = Len(BinVal)

For i = Length - 2 To 1 Step -3
    ConvertBinaryToOctal = GetValue(Mid(BinVal, i, 3), False) + ConvertBinaryToOctal
Next i
End Function

Private Function GetValue(strBinary As String, blnRemainder As Boolean) As String
Dim intPwrOfTwo As Integer
Dim intResult As Integer
intResult = 0
intPwrOfTwo = -1
For i = Len(strBinary) To 1 Step -1
    intPwrOfTwo = intPwrOfTwo + 1
    strChar = Mid(strBinary, i, 1)
    If strChar = "1" Then
        intResult = intResult + 2 ^ intPwrOfTwo
    End If
Next
GetValue = LTrim(Str(intResult))
End Function