Uploading excel cell value to FTP site via VBA

Question

Just wondering if anyone has any experience of uploading a cell value from an excel spreadsheet and appending to a list in a text file on a FTP site?

Basically, within my company, we use certain excel spreadsheets to compile data for client reporting. As these are only excel files they can be easily saved to a USB and "Stolen" by staff members who leave the company. Our thinking was that we could upload the username from the PC using the spreadsheet and list it in a text file (this all needs doing as stealthily as possible!). We could then cross reference that to another list and "Blacklist" the users and lock out the spreadsheet so it can't be used.

Not sure if this is wildly ambitious but just thought I'd try and get some feedback.

Thanks in advance!

What you are asking can be accomplished. However, using VBA to "lock out" a workbook is a mild deterrent at best, a user could simply not allow macros, save the workbook in a macro-less format and access any information it stores statically. If you want a *truly secure* means of storing sensitive data, putting it in an Excel spreadsheet is not the best solution. — Ross McConeghy, Aug 19 '14 at 19:21
Thanks, it's not overly sensitive information however the industry of which I work means that staff do move between companies and we don't want them to move reporting templates with them. By the very nature of the reports, macros would need to be activated to use the reports — elmonko, Aug 19 '14 at 19:29
Similar Q&As: http://stackoverflow.com/questions/2914647/ftp-a-text-file-to-a-server-using-vba-in-excel http://stackoverflow.com/questions/7737691/upload-file-via-ftp-from-excel-vba http://stackoverflow.com/questions/2914647/ftp-a-text-file-to-a-server-using-vba-in-excel — Ross McConeghy, Aug 19 '14 at 21:37

score 0 · Accepted Answer · answered Aug 26 '14 at 20:51

Ok, so this is what I've come up with, it uses the 'Temp' folder to add a "Dat", "Bat" & "Txt" file which, once processed, are deleted.

Option Explicit

Public Function UserName()
UserName = Environ$("UserName")
End Function

Function above is to find the username associated with the PC...

Private Sub IDLoad()

Application.ScreenUpdating = False

Sheets("FileOpen").Select
    Range("E1").Clear
    Range("E1").FormulaR1C1 = "=UserName()"
    Range("E1").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False

Range("G1").Select

Dim TextFile As Variant
Dim TempFldr As String, UN As String, workbook_subname As String, batfile As String, scriptfile As String, filescript As String, batyfile As String
Dim FileOpen_wb As Workbook
Dim ws As Worksheet

TempFldr = Environ("Temp") & "\"

If Sheets("FileOpen").Range("E1").text = "" Then
UN = "No User"
Else
UN = Sheets("FileOpen").Range("E1").text
End If


workbook_subname = "IDCheck"
scriptfile = TempFldr + workbook_subname + " - Script.dat"
filescript = TempFldr + workbook_subname + " - Script1.dat"
batfile = TempFldr + workbook_subname + " - upload.bat"
batyfile = TempFldr + workbook_subname + " - upload1.bat"

Set TextFile = CreateObject("Scripting.FileSystemObject").CreateTextFile(filescript, True)
TextFile.writeline "idcheck@mywebsite.co.uk"     'username
TextFile.writeline "password" 'password
TextFile.writeline "cd GK" 'directory on FTP site
TextFile.writeline "text"
TextFile.writeline "get GKBlacklist.txt " & TempFldr & "GKBlacklist.txt"
TextFile.writeline "bye"
TextFile.Close

Set TextFile = CreateObject("Scripting.FileSystemObject").CreateTextFile(batyfile, True)
TextFile.writeline "ftp -s:" + Chr(34) + filescript + Chr(34) + " www.mywebsite.co.uk"
TextFile.writeline "del " + Chr(34) + filescript + Chr(34)
TextFile.writeline "del " + Chr(34) + batyfile + Chr(34)
TextFile.Close

'Upload
Shell pathname:=Chr(34) + batyfile + Chr(34), windowstyle:=vbHide 'vbMinimizedNoFocus



'Export Cell Value to textfile
Set TextFile = CreateObject("Scripting.FileSystemObject").CreateTextFile(TempFldr & UN & ".txt", True)
TextFile.writeline Sheets("FileOpen").Range("E1").text
TextFile.Close



'Create FTP files...
Set TextFile = CreateObject("Scripting.FileSystemObject").CreateTextFile(scriptfile, True)
TextFile.writeline "idcheck@mywebsite.co.uk"     'username
TextFile.writeline "password" 'password
TextFile.writeline "cd GK" 'directory on FTP site
TextFile.writeline "text"
TextFile.writeline "get GKBlacklist.txt " & TempFldr & "GKBlacklist.txt"
TextFile.writeline "put " + Chr(34) + TempFldr & UN & ".txt" + Chr(34) 'file to be uploaded
TextFile.writeline "bye"
TextFile.Close


'Check if file is GKBlacklisted
Worksheets("FileOpen").Activate
Dim myFile As String, Data As String
myFile = TempFldr & "GKBlacklist.txt"


Dim r As Integer


If Dir(myFile) = "" Then
GoTo 1
End If
 Open myFile For Input As #1
    r = 0
    Do Until EOF(1)
        Line Input #1, Data
        Worksheets("FileOpen").Range("F1").Offset(r, 0) = Data
        r = r + 1
    Loop
    Close #1

1:
'Create script Files

Set TextFile = CreateObject("Scripting.FileSystemObject").CreateTextFile(batfile, True)
TextFile.writeline "ftp -s:" + Chr(34) + scriptfile + Chr(34) + " www.mywebsite.co.uk"
TextFile.writeline "del " + Chr(34) + TempFldr & UN & ".txt" + Chr(34)
TextFile.writeline "del " + Chr(34) + scriptfile + Chr(34)
TextFile.writeline "del " + Chr(34) + batfile + Chr(34)

TextFile.Close



Shell pathname:=Chr(34) + batfile + Chr(34), windowstyle:=vbHide 'vbMinimizedNoFocus


Application.Run "BLV"

Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Below is the sub for checking the cell value and returning a message box if the username has been 'Blacklisted'

Private Sub BLV()
Application.ScreenUpdating = False
    Dim i As Integer, intValueToFind As String
    intValueToFind = Environ$("UserName")
    For i = 1 To 30
        If Cells(i, 6).Value = intValueToFind Then 'Remember to change row number!
       Application.Visible = False
             MsgBox "You are using an unlicensed version of this report." & vbCrLf & "Please contact my company to renew your license...", vbCritical + vbOKOnly, "My Company Ltd"
            Application.DisplayAlerts = False

            ActiveWorkbook.Close
            Exit Sub
        End If
    Next i

Sheets("Data").Select
Range("F9").Select
  Application.ScreenUpdating = True
End Sub

I have this called on both the Open and Close events of the worksheet in case an internet connection is not available when the workbook is opened,

Uploading excel cell value to FTP site via VBA

1 Answers1