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 = "" 'get one or more gif files vFname = Application.GetOpenFilename("*.gif; *.jpg, *.gif; *.jpg", , , , True) 'If vFname <> "False" Then '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 'End If 'SendViaFtp vFname SendViaSCP 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 Dim sPath As String Const sSITE As String = "ftp.mysite.com" Const sUSER As String = "MyUserName" Const sPASS As String = "MyPassword" Const sDIR As String = "public_html/ddoe/blogpix/" sPath = Environ$("TMP") & Application.PathSeparator 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.