Archive for the ‘Enumerations’ Category.

FTP Via VBA

One of my new year's resolutions was to write a procedure to ftp picture files to this blog to simplify the procedure. It took two days, but I finally got it done. I don't know if it's well done, but it works. I got a little help along the way, specifically:

Forestasia has code to determine the image size. Another resolution is to put height and width arguments in my img tags. I tried about 17 other things before finding this page, such as looking at the extended file properties like Walkenbach did with MP3s. I'm glad I found it, though, because I learned something about the GIF file format. Nice use of Get.

Speaking of that, I read the GIF89a file specification to see what else I could learn. I had a little trouble applying the spec to the bits (which I printed to a worksheet for inspection). For one, it was clear from Forestasia's code that the dimensions were stored in two bits; one with size mod 256 and the other with the number of full 256's, but I couldn't find that in the spec. I was going to make an all white GIF and an all black GIF and compare the bits, but I lost interest.

For the FTP stuff, I went to bygsoftware. I read about ftp subcommands in Windows help, but all my attempts to change bygsoftware's code failed. It ended up looking pretty much like they have it.

Finally, since I can never remember how to stuff text into the clipboard, I went back (as always) to Chip's Clipboard page. Forms 2.0. Oh yeah, now I remember.

The code is a bit long, but there's some good stuff in there.

Enum gdGifDims
    gdHeight = 0
    gdWidth = 1
End Enum
 
Sub UploadPicture()
   
    Dim vFname As Variant
    Dim i As Long
    Dim sTags As String
    Dim lHeight As Long
    Dim lWidth As Long
   
    Const sIMG As String = "<img src="""
    Const sPATH As String = "http://www.dicks-blog.com/blogpix/"
    Const sIMGEND As String = " alt="""" />"
   
    'get one or more gif files
    vFname = Application.GetOpenFilename("*.gif, *.gif", , , , True)
   
    'Make the img tags
    For i = LBound(vFname) To UBound(vFname)
        lHeight = GetGifDim(vFname(i), gdHeight)
        lWidth = GetGifDim(vFname(i), gdWidth)
        sTags = sTags & sIMG & sPATH & Dir(vFname(i)) & Chr$(34) & _
            " height=" & lHeight & _
            " width=" & lWidth & _
            sIMGEND & vbCrLf
    Next i
   
    SendViaFtp vFname
   
    'put string in clipboard
    PutInClip sTags
   
End Sub
 
Function GetGifDim(ByVal sFname As String, ByVal eDim As gdGifDims) As Long
   
    Dim btBuffer(10) As Byte 'to get the first 10 bits
    Dim lFnum As Long
   
    lFnum = FreeFile
   
    'open the file and read in the bits
    Open sFname For Binary As lFnum
    Get lFnum, 1, btBuffer
    Close lFnum
   
    If eDim = gdHeight Then
        GetGifDim = btBuffer(8) + (btBuffer(9) * 256)
    Else
        GetGifDim = btBuffer(6) + (btBuffer(7) * 256)
    End If
   
End Function
 
Sub SendViaFtp(vFname As Variant)
   
    'code modified from http://www.bygsoftware.com/Excel/VBA/ftp.htm
   
    Dim i As Long
    Dim lFnumFtp As Long, lFnumBatch As Long
    Dim sFname As String
   
    Const sPATH As String = "C:\"
    Const sSITE As String = "123.45.678.901"
    Const sUSER As String = "MyUserName"
    Const sPASS As String = "MyPassword"
    Const sDIR As String = "www\blogpix\"
           
    sFname = sPATH & Format(Now, "yyyymmddhhmm")
    lFnumFtp = FreeFile
   
    'Create text file with ftp commands
    Open sFname & ".txt" For Output As lFnumFtp
    Print #lFnumFtp, "open " & sSITE 'open the site
    Print #lFnumFtp, sUSER
    Print #lFnumFtp, sPASS
    Print #lFnumFtp, "binary" 'set file transfer mode
    Print #lFnumFtp, "cd " & sDIR
    For i = LBound(vFname) To UBound(vFname)
        Print #lFnumFtp, "send " & Dir(vFname(i)) 'send files
    Next i
    Print #lFnumFtp, "bye" 'close ftp session
   
    Close lFnumFtp  'close text file
   
    lFnumBatch = FreeFile
   
    'open a batch file
    Open sFname & ".bat" For Output As lFnumBatch
    Print #lFnumBatch, "ftp -s:" & sFname & ".txt"
    Print #lFnumBatch, "Echo ""Complete""> " & sFname & ".out"
    Close lFnumBatch
   
    'run the batch file
    Shell sFname & ".bat"
   
    'what until the ftp session is closed
    Do While Dir(sFname & ".out") = ""
        DoEvents
    Loop
   
    Application.Wait Now + TimeValue("0:00:03")
   
    'clean up files used
    On Error Resume Next
        Kill sFname & ".txt"
        Kill sFname & ".bat"
        Kill sFname & ".out"
    On Error GoTo 0
   
End Sub
 
Sub PutInClip(sTags As String)
   
    Dim doObject As DataObject
   
    Set doObject = New DataObject
   
    doObject.SetText sTags
    doObject.PutInClipboard
   
End Sub

What kind of dink would I be if I didn't actually have a picture on this post? Here's the first part of the 12,365 bits of GIF file on my computer. The bits actually start at 1 (if you're using the Get Statement), but the array they were stored in was zero based.

Excel range listing first few bits of GIF format

Custom Enumerations

Consider this statement:

MsgBox "Hello!", vbCritical + vbYesNo

vbCritical and vbYesNo are members of a built-in enumeration called vbMsgBoxStyle. You can create your own enumerations containing constants of your choice for use in your applications. To do so, you use the Enum statement at the module level.

Enum dkMsgText
    dkHello = 1
    dkWorld = 2
    dkExclaim = 4
End Enum

In the above example, the members are assigned specific values, but those values are optional. If you omit the values, they are automatically assigned consecutive long integers starting with zero (0,1,2...).

Enumerations can be additive or non-additive. The enumeration for a MsgBox style is additive, meaning that you can add members together. There's nothing special in the Enum statement that identifies additive enumerations, it's the code that accepts the enumeration that handles the additive nature. For built-in, additive enumerations, the values assigned to the members are usually 1, 2, 4, 8, 16, etc. so you can add two or more together and get a unique number.

Here's a sub that accepts the above enumeration to create a message box.

Sub SayHello(eText As dkMsgText)

    Dim sText As String
    
    Select Case eText
        Case 1
            sText = "Hello "
        Case 2
            sText = "World "
        Case 3
            sText = "Hello World "
        Case 4
            sText = "!"
        Case 5
            sText = "Hello !"
        Case 6
            sText = "World !"
        Case 7
            sText = "Hello World !"
    End Select
    
    MsgBox sText
    
End Sub

Sub CallSayHello()

    SayHello dkHello + dkWorld
    
End Sub

Testing the additive nature of the enumeration can be done without testing every possible combination by using bitwise comparisons. But that's a subject for another post.