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.
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.
