Premise: Copying files from Linux to Windows over FTP using WinInet FtpGetFile.
Objective: The files originate as ANSI and are needed in Unicode.
Progress:
The only issue I am having is that I need LF characters from the original file to be CRLF characters in the destination file.
I have tried:
Public Declare Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileW" (ByVal hFTP As Long, ByVal sRemoteFile As String, ByVal sNewFile As String, ByVal bFailIfExists As Boolean, ByVal lFlagsAndAttributes As Long, ByVal lFlags As Long, ByVal lContext As Long) As Boolean
Public Sub test(hConn as Long, strSrcPath as String, strDestPath as String)
'All code works other than the file not converting to having CR chars
ftpGetFile(hConn, StrConv(strSrcPath, vbUnicode), StrConv(strDestPath, vbUnicode), True, 0, 0, 0)
End Sub
(FAILS to convert) using the Unicode version of the FtpGetFile method (Alias FtpGetFileW), passing the arguments using StrConv(<string>, vbUnicode). The files show up with only LF chars at the end of the lines.
(WORKS, manually) copying files manually using WinSCP. It automatically makes the output files Unicode but I can't find the method/settings associated with this. I cannot use the WinSCP.dll at my work as I cannot register it.
(WORKS, slowly) using a work-around. using the either version of the FtpGetFile. Opening file, reading to variable, closing file and then opening file for write, writing Replace(variable,Chr(10),Chr(13)&Chr(10)). Also, files appear to ~double in size.
How do I get a file using the WinAPI functions and have it convert in one shot (if possible)?
Related articles:
Unicode turns ANSI after FTP transfer
Writing ANSI string to Unicode file over FTP
Source Info:
How to Create FTP Components CodeGuru
MSDN for WinInet
The following appears to be working near instantaneously. If anyone has any better suggestions on how to automate this (preferably without this work-around or to make my work-around better) please provide them. Otherwise, I'll probably be choosing this as the answer in a few days. ftpReadFile is a custom function that uses InternetReadFile and spits out the entire file as a string.
Public Function ftpGetFileToUnicode(hConn As Long, strFromPath As String, strDestPath As String) As Boolean
Dim hFile As Long
Dim objFS As New FileSystemObject, objFile As TextStream
If Not objFS.FileExists(strDestPath) Then
Set objFile = objFS.CreateTextFile(strDestPath, ForWriting)
objFile.Write Replace(ftpReadFile(hConn, strFromPath), Chr(10), Chr(13) & Chr(10))
objFile.Close
If objFS.GetFile(strDestPath).Size > 0 Then
ftpGetFileToUnicode = True
Exit Function
End If
End If
ftpGetFileToUnicode = False
End Function
Note: Creates a 0 byte file if the file doesn't exist. Can easily be changed to not do that.
Disclaimer: I know nothing about VB. But FtpGetFile says it supports ASCII mode transfers, which have implicit line ending conversion:
ftpGetFile(hConn, StrConv(strSrcPath, vbUnicode), StrConv(strDestPath, vbUnicode),
True, 0, FTP_TRANSFER_TYPE_ASCII, 0)
Related
I have looked at several similar questions so this is not for lack of trying.
I want to create a DSN to Postgres using VBA. I specifically don't want to use a DSN-less connection in Access. I'm suspecting it could be my connection string rather than the code but I'm not sure and I don't get any errors its just unsuccessful.
My code is as follows:
Option Compare Database
Option Explicit
Private Declare Function SQLConfigDataSource Lib "ODBCCP32.DLL" _
(ByVal hwndParent As Long, ByVal fRequest As Long, _
ByVal lpszDriver As String, ByVal lpszAttributes As String) _
As Long
Private Const ODBC_ADD_SYS_DSN = 4
Public Function CreateDSN(Driver As String, Attributes As _
String) As Boolean
CreateDSN = SQLConfigDataSource(0&, ODBC_ADD_SYS_DSN, _
Driver, Attributes)
End Function
Sub test()
Dim strConnection As String
strConnection = "ODBC;DSN=Postgres_Test;Driver=PostgreSQL Unicode;Server=************.*********.***.****;Port=*****;Database=example;Uid=********;Pwd=****************;"
Debug.Print CreateDSN("PostgreSQL Unicode", strConnection)
End Sub
All I have to go on here is False in the immediate window.
If someone could confirm if it is just the connection string (and what the right syntax is) that'd be useful. I tried looking at the properties of a linked table in Access of one where I manually created the DSN and its that and this that I used to generate the one I'm using already.
SQLConfigDataSource doesn't take a connection string. It takes a driver name, and attributes.
Let's dissect the connection string:
ODBC; : DAO-specific prefix indicating an ODBC connection string. Never needed outside of Access/DAO.
DSN=Postgres_Test: DSN name
Driver=PostgreSQL Unicode: Driver name, should never be combined with DSN name in a connection string as the DSN specifies the driver name
Server=************.*********.***.****;Port=*****;Database=example;Uid=********;Pwd=****************;: Driver-specific attributes.
If we look at the documentation, the driver attributes should be null-separated, not separated by ;, and the string should end with a double null separator.
So, the final call would need to look like this:
CreateDSN = SQLConfigDataSource(0&, ODBC_ADD_SYS_DSN, _
"PostgreSQL Unicode", "DSN=Postgres_Test" & vbNullChar & "SERVER=***" & vbNullChar & "Port=*****" & vbNullChar & 'Etc)
Making sure that to end on a vbNullChar
Furthermore, fRequest is a Word, and a Word corresponds to an Integer in VBA, so your declaration should be adjusted for that.
However, as Max pointed out, Access has a built-in for registering DSNs, and you should probably just use that, as it's way easier.
I need to do a one time download of a pipe deliminated text file in VBA. I have tried many of the solutions in other stack overflow questions but I can't seem to make any of the solutions work. It's from the internal wiki page of my firm.
The file is something like: https://wiki.somecompany/downloads/attachments/data.txt
Note: that is not a real url
Edit: I am working within excel.
I am extremely new to VBA, so the solutions I read will probably work but they were not idiot proof.
I tried many things, but the most promising looking were the solutions posted here: EXCEL VBA - To open a text file from a website
I stopped working with the first one because it seemed like you needed Mozilla for that one, and I did not know how to specify Chrome.
I messed around with the open workbook option, but I kept getting a compile error that said "Expected: =" but I don't know what the problem is or where it should be.
Edited: #Tim Williams - your solution is the closest to have anything at all happen besides just VBA errors. I got as far as turning my spreadsheet into a log in page, so I guess I need to pass a username and password somehow
You should be able to turn on the Macro Recorder and get what you want pretty quickly. In fact, you probably spent 10x more time describing the scenario, then it would take to record the code you need. Although, it is possible that you actually can't import the data using the Macro Recorder. You should still be able to import the data by referencing a CSV, which I believe is the exact same thing as a Text file.
Sub Import_CSV_File_From_URL()
Dim URL As String
Dim destCell As Range
URL = "http://www.test.com/test.csv"
Set destCell = Worksheets("test").Range("A1")
With destCell.Parent.QueryTables.Add(Connection:="TEXT;" & URL, Destination:=destCell)
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileCommaDelimiter = True
.Refresh BackgroundQuery:=False
End With
destCell.Parent.QueryTables(1).Delete
End Sub
If that doesn't work for you, simply download the file, and do the import from your hard-drive.
Private Declare Function URLDownloadToFile Lib "urlmon" Alias _
"URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal _
szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Sub DownloadFilefromWeb()
Dim strSavePath As String
Dim URL As String, ext As String
Dim buf, ret As Long
URL = Worksheets("Sheet1").Range("A2").Value
buf = Split(URL, ".")
ext = buf(UBound(buf))
strSavePath = "C:\Users\rshuell\Desktop\Downloads\" & "DownloadedFile." & ext
ret = URLDownloadToFile(0, URL, strSavePath, 0, 0)
If ret = 0 Then
MsgBox "Download has been succeed!"
Else
MsgBox "Error"
End If
End Sub
I think I've stumbled upon a bug in Excel - I'd really like to verify it with someone else though.
The bug occurs when reading the Workbook.VBProject.HelpFile property when the workbook has been opened with the opening application's .AutomationSecurity property set to ForceDisable. In that case this string property returns a (probably) malformed Unicode string, which VBA in turn displays with question marks. Running StrConv(..., vbUnicode) on it makes it readable again, but it sometimes looses the last character this way; this might indicate that the unicode string is indeed malformed or such, and that VBA therefore tries to convert it first and fails.
Steps to reproduce this behaviour:
Create a new Excel workbook
Go to it's VBA project (Alt-F11)
Add a new code module and add some code to it (like e.g. Dim a As Long)
Enter the project's properties (menu Tools... properties)
Enter "description" as Project description and "abc.hlp" as Help file name
Save the workbook as a .xlsb or .xlsm
Close the workbook
Create a new Excel workbook
Go to it's VBA project (Alt-F11)
Add a fresh new code module
Paste the code below in it
Adjust the path on the 1st line so it points to the file you created above
Run the Test routine
The code to use:
Const csFilePath As String = "<path to your test workbook>"
Sub TestSecurity(testType As String, secondExcel As Application, security As MsoAutomationSecurity)
Dim theWorkbook As Workbook
secondExcel.AutomationSecurity = security
Set theWorkbook = secondExcel.Workbooks.Open(csFilePath)
Call MsgBox(testType & " - helpfile: " & theWorkbook.VBProject.HelpFile)
Call MsgBox(testType & " - helpfile converted: " & StrConv(theWorkbook.VBProject.HelpFile, vbUnicode))
Call MsgBox(testType & " - description: " & theWorkbook.VBProject.Description)
Call theWorkbook.Close(False)
End Sub
Sub Test()
Dim secondExcel As Excel.Application
Set secondExcel = New Excel.Application
Dim oldSecurity As MsoAutomationSecurity
oldSecurity = secondExcel.AutomationSecurity
Call TestSecurity("enabled macros", secondExcel, msoAutomationSecurityLow)
Call TestSecurity("disabled macros", secondExcel, msoAutomationSecurityForceDisable)
secondExcel.AutomationSecurity = oldSecurity
Call secondExcel.Quit
Set secondExcel = Nothing
End Sub
Conclusion when working from Excel 2010:
.Description is always readable, no matter what (so it's not like all string properties behave this way)
xlsb and xlsm files result in an unreadable .HelpFile only when macros are disabled
xls files result in an unreadable .HelpFile in all cases (!)
It might be even weirder than that, since I swear I once even saw the questionmarks-version pop up in the VBE GUI when looking at such a project's properties, though I'm unable to reproduce that now.
I realize this is an edge case if ever there was one (except for the .xls treatment though), so it might just have been overlooked by Microsoft's QA department, but for my current project I have to get this working properly and consistently across Excel versions and workbook formats...
Could anyone else test this as well to verify my Excel installation isn't hosed? Preferably also with another Excel version, to see if that makes a difference?
Hopefully this won't get to be a tumbleweed like some of my other posts here :) Maybe "Tumbleweed generator" might be a nice badge to add...
UPDATE
I've expanded the list of properties to test just to see what else I could find, and of all the VBProject's properties (BuildFileName, Description, Filename, HelpContextID, HelpFile, Mode, Name, Protection and Type) only .HelpFile has this problem of being mangled when macros are off.
UPDATE 2
Porting the sample code to Word 2010 and running that exhibits exactly the same behaviour - the .HelpFile property is malformed when macros are disabled. Seems like the code responsible for this is Office-wide, probably in a shared VBA library module (as was to be expected TBH).
UPDATE 3
Just tested it on Excel 2007 and 2003, and both contain this bug as well. I haven't got an Excel XP installation to test it out on, but I can safely say that this issue already has a long history :)
I've messed with the underlying binary representation of the strings in question, and found out that the .HelpFile string property indeed returns a malformed string.
The BSTR representation (underwater binary representation for VB(A) strings) returned by the .HelpFile property lists the string size in the 4 bytes in front of the string, but the following content is filled with the ASCII representation and not the Unicode (UTF16) representation as VBA expects.
Parsing the content of the BSTR returned and deciding for ourselves which format is most likely used fixes this issue in some circumstances. Another issue is unfortunately at play here as well: it only works for even-length strings... Odd-length strings get their last character chopped off, their BSTR size is reported one short, and the ASCII representation just doesn't include the last character either... In that case, the string cannot be recovered fully.
The following code is the example code in the question augmented with this fix. The same usage instructions apply to it as for the original sample code. The RecoverString function performs the needed magic to, well, recover the string ;) DumpMem returns a 50-byte memory dump of the string you pass to it; use this one to see how the memory is layed out exactly for the passed-in string.
Const csFilePath As String = "<path to your test workbook>"
Private Declare Sub CopyMemoryByte Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Byte, ByVal Source As Long, ByVal Length As Integer)
Private Declare Sub CopyMemoryWord Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Integer, ByVal Source As Long, ByVal Length As Integer)
Private Declare Sub CopyMemoryDWord Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Long, ByVal Source As Long, ByVal Length As Integer)
Function DumpMem(text As String) As String
Dim textAddress As LongPtr
textAddress = StrPtr(text)
Dim dump As String
Dim offset As Long
For offset = -4 To 50
Dim nextByte As Byte
Call CopyMemoryByte(nextByte, textAddress + offset, 1)
dump = dump & Right("00" & Hex(nextByte), 2) & " "
Next
DumpMem = dump
End Function
Function RecoverString(text As String) As String
Dim textAddress As LongPtr
textAddress = StrPtr(text)
If textAddress <> 0 Then
Dim textSize As Long
Call CopyMemoryDWord(textSize, textAddress - 4, 4)
Dim recovered As String
Dim foundNulls As Boolean
foundNulls = False
Dim offset As Long
For offset = 0 To textSize - 1
Dim nextByte As Byte
Call CopyMemoryByte(nextByte, textAddress + offset, 1)
recovered = recovered & Chr(CLng(nextByte) + IIf(nextByte < 0, &H80, 0))
If nextByte = 0 Then
foundNulls = True
End If
Next
Dim isNotUnicode As Boolean
isNotUnicode = isNotUnicode Mod 2 = 1
If foundNulls And Not isNotUnicode Then
recovered = ""
For offset = 0 To textSize - 1 Step 2
Dim nextWord As Integer
Call CopyMemoryWord(nextWord, textAddress + offset, 2)
recovered = recovered & ChrW(CLng(nextWord) + IIf(nextWord < 0, &H8000, 0))
Next
End If
End If
RecoverString = recovered
End Function
Sub TestSecurity(testType As String, secondExcel As Application, security As MsoAutomationSecurity)
Dim theWorkbook As Workbook
secondExcel.AutomationSecurity = security
Set theWorkbook = secondExcel.Workbooks.Open(csFilePath)
Call MsgBox(testType & " - helpfile: " & theWorkbook.VBProject.HelpFile & " - " & RecoverString(theWorkbook.VBProject.HelpFile))
Call MsgBox(testType & " - description: " & theWorkbook.VBProject.Description & " - " & RecoverString(theWorkbook.VBProject.Description))
Call theWorkbook.Close(False)
End Sub
Sub Test()
Dim secondExcel As Excel.Application
Set secondExcel = New Excel.Application
Dim oldSecurity As MsoAutomationSecurity
oldSecurity = secondExcel.AutomationSecurity
Call TestSecurity("disabled macros", secondExcel, msoAutomationSecurityForceDisable)
Call TestSecurity("enabled macros", secondExcel, msoAutomationSecurityLow)
secondExcel.AutomationSecurity = oldSecurity
Call secondExcel.Quit
Set secondExcel = Nothing
End Sub
I have successfully coded some VBA macros for work which basically create a data file, feed it to a program and post-treat the output from this program.
My issue is that the program installation path is hard coded in the macro and the installation may vary accross my colleagues computers.
The first thing I thought is that I can gather from everyone the different installation directories and test for all of them in the code. Hopefully, one of them will work. But it doesn't feel that clean.
So my other idea was to somehow get the installation directory in the code. I thought it would be possible as in Windows, if I right click on a shortcut, I can ask to open the file's directory. What I'm basically looking for is an equivalent in VBA of this right click action in Windows. And that's where I'm stuck.
From what I found, Windows API may get the job done but that's really out of what I know about VBA.
The API FindExecutable seemed not too far from what I wanted but I still can't manage to use it right. So far, I can only get the program running if I already know its directory.
Could you give me some pointers ? Thanks.
Here's another method for you to try. Note that you might see a black box pop up for a moment, that's normal.
Function GetInstallDirectory(appName As String) As String
Dim retVal As String
retVal = Split(CreateObject("WScript.Shell").Exec("CMD /C FOR /r ""C:\"" %i IN (*" & appName & ") DO (ECHO %i)").StdOut.ReadAll, vbCrLf)(2)
GetInstallDirectory = Left$(retVal, InStrRev(retVal, "\"))
End Function
It's not as clean as using API but should get the trick done.
Summary:
retVal = Split(CreateObject("WScript.Shell").Exec("CMD /C FOR /r ""C:\"" %i IN (*" & appName & ") DO (ECHO %i)").StdOut.ReadAll, vbCrLf)(1)
"CMD /C FOR /r ""C:\"" %i IN (*" & appName & ") DO (ECHO %i)" is a command that works in CMD to loop through files rooted at a defined path. We use the wildcard with the appName variable to test for the program we want. (more info on FOR /R here) Here, we have created the CMD application using a Shell object (WScript.Shell) and Executed the command prompt CMD passing arguments to it directly after. The /C switch means that we want to pass a command to CMD and then close the window immediately after it's processed.
We then use .StdOut.ReadAll to read all of the output from that command via the Standard Output stream.
Next, we wrap that in a Split() method and split the output on vbCrLf (Carriage return & Line feed) so that we have a single dimension array with each line of the output. Because the command outputs each hit on a new line in CMD this is ideal.
The output looks something like this:
C:\Users\MM\Documents>(ECHO C:\Program Files\Microsoft
Office\Office14\EXCEL.EXE ) C:\Program Files\Microsoft
Office\Office14\EXCEL.EXE
C:\Users\MM\Documents>(ECHO
C:\Windows\Installer\$PatchCache$\Managed\00004109110000000000000000F01FEC\14.0.4763\EXCEL.EXE
)
C:\Windows\Installer\$PatchCache$\Managed\00004109110000000000000000F01FEC\14.0.4763\EXCEL.EXE
C:\Users\olearysa\Documents>(ECHO
C:\Windows\Installer\$PatchCache$\Managed\00004109110000000000000000F01FEC\14.0.7015\EXCEL.EXE
)
C:\Windows\Installer\$PatchCache$\Managed\00004109110000000000000000F01FEC\14.0.7015\EXCEL.EXE
We're only interested in the third line of the output (the first line is actually blank), so we can access that index of the array directly by using (2) after it (because arrays are zero-indexed by default)
Finally, we only want the path so we use a combination of Left$() (which will return n amount of characters from the left of a string) and InStrRev() (which returns the position of a substring starting from the end and moving backwards). This means we can specify everything from the left until the first occurrence of \ when searching backwards through the string.
Give this a try, assuming you know the name of the .exe:
#If Win64 Then
Declare PtrSafe Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" _
(ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As Long
#Else
Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" _
(ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As Long
#End If
Const SYS_OUT_OF_MEM As Long = &H0
Const ERROR_FILE_NOT_FOUND As Long = &H2
Const ERROR_PATH_NOT_FOUND As Long = &H3
Const ERROR_BAD_FORMAT As Long = &HB
Const NO_ASSOC_FILE As Long = &H1F
Const MIN_SUCCESS_LNG As Long = &H20
Const MAX_PATH As Long = &H104
Const USR_NULL As String = "NULL"
Const S_DIR As String = "C:\" '// Change as required (drive that .exe will be on)
Function GetInstallDirectory(ByVal usProgName As String) As String
Dim fRetPath As String * MAX_PATH
Dim fRetLng As Long
fRetLng = FindExecutable(usProgName, S_DIR, fRetPath)
If fRetLng >= MIN_SUCCESS_LNG Then
GetInstallDirectory = Left$(Trim$(fRetPath), InStrRev(Trim$(fRetPath), "\"))
End If
End Function
Example of how to use, let's try looking for Excel:
Sub ExampleUse()
Dim x As String
x = "EXCEL.EXE"
Debug.Print GetInstallDirectory(x)
End Sub
Output (on my machine anyway) is
C:\Program Files\Microsoft Office\Office14\
Assuming you are working on PC only and the people are working with their own copies and not a shared network copy. I would recommend the following.
Create a Sheet called 'Config', place the path with the exe in there, and then hide it.
Use use FileScriptingObject ('Tools' > 'References' > 'Microsoft Scripting Runtime') to see if the path in 'Config' exists
If it does not, ask the user for the location using a 'open file dialog box' and remember that in the 'Config' Sheet for next time.
The below code may help as a pointer.
Dim FSO As New FileSystemObject
Private Function GetFilePath() As String
Dim FlDlg As FileDialog
Dim StrPath As String
Set FlDlg = Application.FileDialog(msoFileDialogOpen)
With FlDlg
.Filters.Clear
.Filters.Add "Executable Files", "*.exe"
.AllowMultiSelect = False
.ButtonName = "Select"
.Title = "Select the executable"
.Show
If .SelectedItems.Count <> 0 Then GetFilePath = .SelectedItems(1)
End With
Set FlDlg = Nothing
End Function
Private Function FileExists(ByVal StrPath As String) As Boolean
FileExists = FSO.FileExists(StrPath)
End Function
I'm on a quest to figure out how to identify different icon overlays through Excel VBA.
There is a cloud syncing software and I am trying to identify whenever the syncing of my excel file has finished or still in progress. I was able to achieve a basic level of reliability by following the modification date of some meta(?) files but there is not enough consistency to fully rely on this method.
The result of my searches is a big punch in the face, since there is not much info about it in VBA. Basically all I have found that everyone uses advanced languages like C++ to handle these things.
The closest source I've got in VBA does something similar with the System Tray and uses the shell32.dll calling the appropiate windows api (link). But I have no idea how to make it to the Shell Icon Overlay Identifier.
What do you guys think, is there a possible way to make it through VBA or I have to learn C++?
Awesome! It is possible! The SHGetFileInfo method works!
It gives me values according to the current overlays. Here is the code for any other crazy people who wanna mess around with it:
Const SHGFI_ICON = &H100
Const SHGFI_OVERLAYINDEX = &H40
Const MAX_PATH = 260
Const SYNCED = 100664316 'own specific value
Const UNDSYNC = 117442532 'own specific value
Private Type SHFILEINFO
hIcon As Long 'icon
iIcon As Long 'icon index
dwAttributes As Long 'SFGAO_ flags
szDisplayName As String * MAX_PATH 'display name (or path)
szTypeName As String * 80 'type name
End Type
Private Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" _
(ByVal pszPath As String, _
ByVal dwFileAttributes As Long, _
psfi As SHFILEINFO, _
ByVal cbFileInfo As Long, _
ByVal uFlags As Long) As Long
Private Sub GetThatInfo()
Dim FI As SHFILEINFO
SHGetFileInfo "E:\Test.xlsm", 0, FI, Len(FI), SHGFI_ICON Or SHGFI_OVERLAYINDEX
Select Case FI.iIcon
Case SYNCED
Debug.Print "Synchronized"
Case UNDSYNC
Debug.Print "Synchronization in progress"
Case Else
Debug.Print "Some shady stuff is going on!"
End Select
End Sub
Thanks for the tip again!