Background: I am extracting a file that is saved in a SQL database using an ADODB connection. One column of the database is the filename, including the file extension, and another is the actual contents of the file as a hex stream. I would like to save this file and open it.
Problem: This works fine with .pdf files. However, with .png files there is an error- the file is corrupted when I try to open it. I used a hex editor (HxD) and noticed that there were excess values. If I remove these the file opens fine. The hex stream should begin with the "per mille" character (Chr(137) in excel) in order for the file to open. I have not found a way to edit the hex stream in excel without converting it to characters.
The .png file opens with no problem when I take out the first few characters using a hex editor so that the file begins with:
‰PNG
Or the equivalent in hex code:
89 50 4E 47
The excess characters are
ÿþ
Or the equivalent in hex code:
FF FE
(I am trying to remove these). These characters are in the saved file even when I remove 4 characters from the text string using
Content = Right(Content, Len(Content) - 4)
It's almost like they automatically get added before the string when I save the file.
Code:
Calling the save to file function, where Content is the file content and Name is the filename:
Call StringToTextFile("C:\", rst![Content], rst![Name])
The function is below:
Public Sub StringToTextFile(ByVal directory As String, ByVal Content As String, ByVal filename As String)
'Requires reference to scrrun.dll
Dim fso As Scripting.FileSystemObject
Dim ts As Scripting.TextStream
Set fso = New Scripting.FileSystemObject
If Right(filename, 4) = ".png" Then 'recognizing the .png file
'Content = CByte(Chr(137)) & Right(Content, Len(Content)) 'unsuccessful attempt at inserting "per mille" character
'iret = InStr(0, Chr(137), Content, vbBinaryCompare) 'unsuccessful attempt at finding the "per mille" character in the content
End If
Set ts = fso.CreateTextFile(directory & filename, True, True)
ts.Write Content
ts.Close
Dim myShell As Object
Set myShell = CreateObject("WScript.Shell")
myShell.Run directory & filename 'Open the saved file
End Sub
When I try to insert the "per mille" character using Chr(137) it just shows a blank space in the hex editor.
Any help is appreciated!
This seems to be a similar discussion, but I am unsure how to apply this to my case:
excel-vba-hex-to-ascii-error
Related
The problem is, I want to copy data from .csv file, but excel automatically separates it into columns by comma, I need to separate it by ";".Can I edit csv file using vba code to add 'sep=' at the beginning?
Excel/VBA ignores the separator option if the file has the .csv extension. You have to rename it to set the delimiter. Check out my VBA CSV parser project.
The solution worked for me is to use filesystem object to read csv file and copy it into temporary file with 'sep=' at the first line.
Here is the code:
Function readCsvF(delim as String, fPath as String) As String
Dim sourceFile As Object, objFSO as Object, newTempFile as Object, _
line as String, newName as String
Set objFSO = CreateObject("scripting.FileSystemObject")
Set sourceFile = objFSO.OpenTextFile(fPath)
newName = objFSO.GetParentFolderName(fPath) & "\tempCSVfile.csv"
Set newTempFile = objFSO.CreateTextFile(newName, True)
newTempFile.Writeline("sep=" & delim)
While Not sourceFile.AtEndOfStream
line = sourceFile.Readline
newTempFile.Writeline (line)
Wend
sourceFile.Close
newTempFile.Close
readCsvF = newName
End Function
So what this function does is basically creates new file in which writes first line sep=*'your specified delimiter'* and then copies data from original csv file line by line. This function takes two string parameters: delim is delimiter you want to use and fPath is a path to the csv file, - and returns a path to the new file, so you can open it as workbook and do whatever manipulation you want with it.
Hopefully this will help someone, I really struggled to find the solution, maybe there was any better way, idk.
I am working on a macro that takes data from a textbox and writes it to a file. The data includes carriage return/Linefeed characters. At a later stage, I need to read the data from the file and put it back in the textbox in exactly the same form. When I do this, the Cr/Lf characters (0d 0a) are missing. I have established that they are written to the file but not read back. I am using the following snippet to write the file:
Print #1, Temstg
Close #1
and reading it using the following snippet:
Do Until EOF(1)
Line Input #1, T
Temstg = Temstg & T
Loop
Close #1
Where am I going wrong
Rob
As said in the comment Line Input considers newline character as the separator for a new line. Here is the documentation.
The following code reads the complete text file in one shot including newline characters.
Sub ReadFIle()
Dim fileName As String: fileName = "C:\temp\yourfile.txt"
Dim fileContent As String
Dim File As Integer: File = FreeFile
Open fileName For Input As #File
fileContent = Input(LOF(File), File)
Close #File
' example how to split the file in lines then
Dim vDat As Variant
vDat = Split(fileContent, vbNewLine)
End Sub
Reading on Input function
Exported text files from Excel are encoded with UTF-8.
An encoding UTF-8-BOM is needed.
I think that in code shall be inserted a row, written like:
Java
?xml version="1.0" encoding="UTF-8"?
Jasperreport CSV UTF-8 without BOM instead of UTF-8
or
HTML5
meta charset="utf-8"
Bad UTF-8 without BOM encoding
Sub export_data()
Dim row, column, i, j As Integer
Dim fullPath, myFile As String
fullPath = "C:\Workspace"
row = 21
column = 5
For i = 1 To column
myFile = Cells(1, i).Value + ".txt"
myFile = fullPath + "/" + myFile
Open myFile For Output As #1
For j = 2 To row
Print #1, Cells(j, i).Value
Next j
Close #1
Next i
End Sub
How can I define and where to put a row, which defines encoding UTF-8-BOM?
Thank You.
Instead of Printing the file line by line, it might be more efficient to
save your selected range as a CSV UTF-8
you might need to change the file type after saving
Use ADO to process the file as UTF-8
Either will add a BOM automatically.
EDIT
If you are unfamiliar, you could perform the save to csv - utf8 process manually with the macro recorder turned on. Then examine what you have recorded and make appropriate edits.
Another way of adding the BOM, in the context of your existing code, would be to write it directly as a byte array to the first line.
For example:
Dim BOM(0 To 2) As Byte 'EF BB BF
BOM(0) = &HEF
BOM(1) = &HBB
BOM(2) = &HBF
Open myFile For Binary Access Write As #1
Put #1, 1, BOM
Close #1
will put the BOM at the beginning of the file.
You should then change the mode in your subsequent Print code to Append.
I suggest you read about the pros and cons of using Print vs Write
You should also read about declaration statements. In yours, only the last variable on each line is being declared as the specified type; the preceding variables are being implicitly declared as being of type Variant.
I am creating a macro in Excel that should open a PDF document on a specified page with chrome.
Generally, the opening part works. My problem is that when I add the page number (e.g. #page=15) to the url, the shell encodes the "#" symbol into "%23", which Chrome is not able to interpret correctly (file not found).
Here is my code
'The path to the file, replaces spaces with the encoding "%20"
Path = Replace((filePath& "#Page=" & iPageNum), " ", "%20")
Dim wshShell, chromePath As String, shellPath As String
Set wshShell = CreateObject("WScript.Shell")
chromePath = wshShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\chrome.exe\")
shellPath = CStr(chromePath) & " -url " & Path
If Not chromePath = "" Then
'how I first tried it:
Shell (shellPath)
'for testing purposes, led to the same result though:
Shell ("""C:\Program Files (x86)\Google\Chrome\Application\chrome.exe"" ""C:\Users\t.weinmuellner\Desktop\Evon\PDF Opening\PDFDocument.pdf#page=17""")
End If
Is there a different way to do this with Chrome? I haven't found anything that reads the installation path dynamically.
You just need to specify the protocol file:/// if you want to load files from the local hard disk. Then # gets not translated into %23.
Shell ("""C:\Program Files (x86)\Google\Chrome\Application\chrome.exe"" ""file:///C:\Users\t.weinmuellner\Desktop\Evon\PDF Opening\PDFDocument.pdf#page=17""")
If Adobe Acrobat Reader is installed on the system I would suggest to use the funcion openPDF from Daniel Pineault. This will open the file in Adobe Reader directly. You can find the source code of the function here
A test could look like that
Sub TestSO()
Dim fileName As String
Dim pageNo As Long
fileName = "Path and filename of PDF"
pageNo = 20
OpenPDF fileName, 20
End Sub
I am trying to open a file with a Unicode file name for binary access to calculate the MD5 check sum. I have the file names and path stored in a excel sheet correctly.
File Names Used:
The code then fails atOpen sPath For Binary Access Read As lngFileNumber with 'Run-Time error'52': Bad file name or number
Function GetFileBytes(ByVal sPath As String) As Byte()
' makes byte array from file
Dim lngFileNum As Long, bytRtnVal() As Byte, bTest
lngFileNum = FreeFile
If LenB(Dir(sPath)) Then ''// Does file exist?
Open sPath For Binary Access Read As lngFileNum
'a zero length file content will give error 9 here
ReDim bytRtnVal(0 To LOF(lngFileNum) - 1&) As Byte
Get lngFileNum, , bytRtnVal
Close lngFileNum
Else
Err.Raise 53 'File not found
End If
GetFileBytes = bytRtnVal
Erase bytRtnVal
End Function
Any suggestions?
You can make the filename "acceptable" by converting it with the StrConv function. I tried your code with this modification:
Open StrConv(sPath, vbUnicode) For Binary Access Read As #1
...and the Open command ran successfully with my test filename abc✓✘.mp3. I can't say for sure if it would works with yours since you included them as an image, but it should be okay.
Unrelated:
The next line (Redim...) has a different problem for you to debug. (Perhaps you can't use LOF with this type of file? or maybe use FileLen instead?.)
More Information:
MSDN : Bad file name or number (Error 52)
CodeGuru : Opening unicode filenames in XP
MSDN : StrConv Function (VBA)
MSDN : LOF Function (VBA)
MSDN : ReDim Statement (VBA)