Question

只是想知道是否有人有任何从Excel电子表格上传单元格值并附加到FTP站点上的文本文件中的列表的经验？

基本上，在我公司内部，我们使用某些Excel电子表格来编译客户报告数据。由于这些只是excel文件，因此可以轻松保存到USB并由离开公司的工作人员“偷走”。我们的想法是，我们可以使用电子表格从PC上传用户名并将其列在文本文件中（这一切都需要尽可能悄悄地进行！）。然后，我们可以将其引用到另一个列表并将用户“黑名单”并锁定电子表格，以便不能使用它。

不确定这是否雄心勃勃但只是想我会尝试获得一些反馈。

提前致谢！

Answer 1

好的，所以这就是我提出的，它使用了＆＃39; Temp＆＃39;用于添加＆＃34; Dat＆＃34;，＆＃34; Bat＆＃34;的文件夹＆安培; ＆＃34; TXT＆＃34;文件，一旦处理，将被删除。

Option Explicit

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

以上功能是查找与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

如果用户名已被黑名单＆＃39;

，则下面是检查单元格值并返回消息框的子项

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

如果在打开工作簿时无法使用Internet连接，我会在工作表的“打开”和“关闭”事件中调用此方法，

通过VBA将excel单元格值上传到FTP站点

1 个答案: