Phantom characters in strings when converting from Sharepoint > Excel > PDF - vba

My organization uses a SP 2010 form to fill information. I didn't build this form, but I've noticed if you try to copy from some of the fields into anywhere else (notepad, etc.) it puts a question mark or euro symbol often directly in front of a string (sometimes in the middle.)
Dim objMyList As ListObject
Dim objWksheet As Worksheet
Dim strSPServer As String
Const SERVER As String = "xxx"
Const LISTNAME As String = "{xxx}"
Const VIEWNAME As String = "{xxx}"
strSPServer = "https://" & SERVER & "/_vti_bin"
Set objWksheet = Sheets("Sheet1")
Set objMyList = objWksheet.ListObjects.Add(xlSrcExternal, _
Array(strSPServer, LISTNAME, VIEWNAME), False, , Range("A1"))
This part of the script pulls the list of the forms that have already been entered into my worksheet, the equivalent of just using the Export to Excel button on the SP website.
The rest of the sub maps each row to a new PDF by way of using a Replace function on an FDF file. These phantom symbols are nowhere to be found on the Excel sheet. There are no blank spaces or characters of any kind.
For i = 2 To lastRow
oldPDF = "C:\~\Auto.pdf"
oldFDF = "C:\~\Auto_data.fdf"
newPDF = "C:\~\" & i & ".pdf"
iFileNum = FreeFile
Open oldFDF For Input As iFileNum
Do Until EOF(iFileNum)
Line Input #iFileNum, sBuf
sTemp = sTemp & sBuf & vbCrLf
Loop
Close iFileNum
Next i
sTemp = Replace(sTemp, "<</T(myFormField)/V( )>>", "<</T(myFormField)/V(" & sht.Range("B" & i) & ")>>")
I open up the PDF to find that the phantom characters are back. So what we have so far:
SharePoint form & Excel sheet:
The quick brown fox jumps over the lazy dog
Text from the SP form copied/pasted and on my PDF:
?The quick brown fox jumps over the lazy dog
I've tried
sTemp = Replace(sTemp, "~?", "")
sTemp = Replace(sTemp, "?", "")
But the symbols still show up on the PDF...and it's useless to do a Replace on the Excel sheet itself because the symbols aren't there.
How do I automatically remove these symbols from the PDF/FDF if the above has not worked?
Edit:
sTemp = Replace(sTemp, Chr(160), "")
Solved the euro symbol issue, but the questions marks remain and I've tried Chr/Chrw(63)

Related

Find and replace characters in strings in all .xlsx files in folder VBA

I am trying to replace characters such as "/" and "ó", and also a line break (alt + ENTER, manually replaced in excel with find and replace with CTRL + J) in excel files (.xlsx). The characters can be found all over the excel sheets (not one particular range). The reason that I would like to replace these values is that these characters are giving me errors in another application.
I have 20 excel files in one folder, with multiple sheets. I would like to make a script (vba macro) to loop through the excel files and all its sheets and do the replacements.
I am very new with vba/macros.
Sub ReplaceStringInFile()
Dim sBuf As String
Dim sTemp As String
Dim sFileName As String
Dim FileExt(2) As String
ChDir = "C:\mydirectory\"
FileExt(1) = "xlsx"
For i = 1 To 1
sFileName = Dir("*." & FileExt(i))
Do
If sFileName = "" Then Exit Do
sTemp = ""
Open sFileName For Input As #1
Do Until EOF(1)
Line Input #1, sBuf
sTemp = sTemp & sBuf & vbCrLf
Loop
Close #1
sTemp = Replace(sTemp, "ó", "o")
sTemp = Replace(sTemp, "/", "")
Open sFileName For Output As #1
Print #1, sTemp
Close #1
sFileName = Dir()
Loop
Next i
End Sub
I have tried to combine code from scripts mentioned here:
Find and replace string in all excel files in folder and here
Excel macro to find and replace multiple strings in any text file
Loop through files in a folder using VBA?
But I didn't get it to work.
Help would be very appreciated!

Using textstream object to replace tab with spaces and delete characters

I have over a thousand .s2p files (a delimited text file used by electrical testing equipment) that were edited by a VBA macro, which opened each raw file in Excel as a tab-and-space delimited text file, and replaced a few of the columns with data columns from another file, then saved them in original format (.s2p) and closed them. This is the call I used to open the each file:
Call Application.Workbooks.OpenText(Filename:=(path & filename & ".s2p"), Origin:="437", DataType:=xlDelimited, ConsecutiveDelimiter:=True, Tab:=True, Space:=True, TextQualifier:=xlTextQualifierNone)
Now, when I open the .s2p files in Notepad to view them, the original single space separating the columns is now a full tab, and some double quote (") characters were added to some of the file header lines (despite setting TextQualifier parameter to xlTextQualifierNone...)
Because of this I want to write another macro that can open all of these .s2p files again, loop through the lines, and replace any double quotes with blanks, and any tabs with single spaces. I was planning to use .OpenAsTextStream on each file, but it seems like the TextStream object doesn't support overwriting lines, but can only write new lines...
Is there a better way to achieve what I am trying to do than just reading lines from the original file, and writing them to a newly created file? It is imperative that I save the final file as ".s2p" and not ".txt".
You don't need the text streams, just the basic input output actions available in VBA.
Option Explicit
Sub test()
FixFile "c:\temp\mytestfile.s2p"
End Sub
Sub FixFile(filename As String)
Dim fnum As Integer
Dim fileText As String
Dim finalText As String
fnum = FreeFile
On Error Resume Next
Open filename For Input As #fnum
If Err.Number <> 0 Then
Debug.Print "Critical error attempting to open " & filename & _
". Error #" & Err.Number & ": " & Err.Description
Exit Sub
End If
finalText = ""
Do Until EOF(fnum)
Line Input #fnum, fileText
fileText = Replace(fileText, """", " ", , , vbTextCompare)
fileText = Replace(fileText, vbTab, " ", , , vbTextCompare)
finalText = finalText & fileText & vbCrLf
Loop
Close fnum
fnum = FreeFile
Open filename For Output As #fnum
Print #fnum, finalText
Close fnum
End Sub
Edited to show line by line read with a final write.

VBA - Replacing commas in CSV not inside quotes

Filename = Dir(Filepath & "\" & "*.csv")
While Filename <> ""
SourceFile = Filepath & "\" & Filename
TargetFile = SavePath & "\" & Replace(Filename, ".csv", ".txt")
OpenAsUnicode = False
Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
'Detect Unicode Files
Dim Stream: Set Stream = objFSO.OpenTextFile(SourceFile, 1, False)
intChar1 = Asc(Stream.Read(1))
intChar2 = Asc(Stream.Read(1))
Stream.Close
If intChar1 = 255 And intChar2 = 254 Then
    OpenAsUnicode = True
End If
'Get script content
Set Stream = objFSO.OpenTextFile(SourceFile, 1, 0, OpenAsUnicode)
arrData = Stream.ReadAll()
Stream.Close
'Create output file
Dim objOut: Set objOut = objFSO.CreateTextFile(TargetFile)
objOut.Write Replace(Replace(arrData,",", "#|#"), Chr(34), "") '-- This line is working fine but it is replacing all the commas inside the text qualifier as well..
objOut.Close
Filename = Dir
Wend
In the above code the line objOut.Write Replace(Replace(arrData,",", "#|#"), Chr(34), "") is replacing all the commas with #|# including the commas inside string.so I want to replace only commas which are not in double quotes.
File containing the string
"A","B,C",D
Result I need is
A#|#B,C#|#D
Thanks for your help in advance.
How about something along the line of:
objOut.Write Mid(Replace(Replace(arrData,""",""", "#|#"), Chr(34), ""), 2)
Basically, this exchanges now "," for #|#. But that's not enough as the file begins with a ". So, this one is being eliminated using the Mid() function. If the file also ends with a " then you would have to adjust that as well.
Based on the speed concerns noted in the comments here is the complete code which I used to test this solution:
Option Explicit
Option Compare Text
Public Sub ConvertFile()
Dim lngRowNumber As Long
Dim strLineFromFile As String
Dim strSourceFile As String
Dim strDestinationFile As String
strSourceFile = "C:\tmp\Extract.txt"
strDestinationFile = "C:\tmp\Extract_b.txt"
Open strSourceFile For Input As #1
Open strDestinationFile For Output As #2
lngRowNumber = 0
Do Until EOF(1)
Line Input #1, strLineFromFile
strLineFromFile = Mid(Replace(strLineFromFile, """,""", "#|#"), 2)
Write #2, strLineFromFile
strLineFromFile = vbNullString
Loop
Close #1
Close #2
End Sub
The tested file was 350 MB with a bit over 4 million rows. The code completed in less than a minute.

Adding accented file name with VBA in outlook message

Saving a file attachment in an Outlook mail item with the VBA method Attachment.SaveAsFile() call produces the expected result (file saved with same filename on the filesystem), even for file names with non-ASCII characters.
However, VBA apparently stores the file name in a 16-bit composite format String where accented letters are stored as a (letter, accent) pair. I can't find a way to output the string inside the message body with accented letters showing up as one glyph ("é") instead of two ("e´").
Concretely, the attachment is properly saved under the correct file name on disk when using the following code:
' Save the Outlook attachment
oAttachment.SaveAsFile (sTempFileLocation)
This results in a file being written to the folder specified in sTempFileLocation and the file name complies with the way it appears in the Outlook message (accents, non-ASCII characters etc).
However, when retrieving and manipulating the file name, it appears that a 16-bit composite internal representation of special characters is used. This means that the file name "à présent.txt" is displayed as "a` pre´sent.txt" (accented characters are represented with the character + the accent in 2 consecutive bytes).
For instance:
sAttachmentName = fso.getfilename(sTempFileLocation)
Debug.Print ("Attachment name = [" & sAttachmentName & "]")
will result in:
Attachment name = [a` pre´sent.txt]
There is little information available on this matter, all I found so far was this MSDN link describing the MultiByteToWideChar() function. From there it appears that the 16-bit internal VBA rendering happens implcitly and is even computer dependent (depending on code page and locale in use).
Here follows a self-contained minimalistic example that tries to save the email attachments of the first selected message to your My Documents folder unless it already exists:
Sub SaveMessageAttachments()
Dim objApp As Outlook.Application
Dim oSelection As Outlook.Selection
Dim aMail As Outlook.MailItem
Dim fso As Object
On Error Resume Next
' Instantiate an Outlook Application object.
Set objApp = CreateObject("Outlook.Application")
' Get the collection of selected objects.
Set oSelection = objApp.ActiveExplorer.Selection
If oSelection Is Nothing Then
Exit Sub
End If
' Select the 1st mail item in the current selection
Set aMail = oSelection.item(1)
Dim sAttachmentFolder As String
' Get the path to your "My Documents" folder
sAttachmentFolder = CreateObject("WScript.Shell").SpecialFolders(16)
Set fso = CreateObject("Scripting.FileSystemObject")
Dim oAttachments As Outlook.Attachments
Dim lItemAttachmentCount As Long
Set oAttachments = aMail.Attachments
lItemAttachmentCount = oAttachments.Count
If (lItemAttachmentCount > 0) Then
Dim lAttachmentIndex As Long
For lAttachmentIndex = 1 To lItemAttachmentCount
Dim oAttachment As Outlook.attachment
Set oAttachment = oAttachments.item(lAttachmentIndex)
Dim sFileName As String
sFileName = oAttachment.FileName
If LenB(sFileName) > 0 Then
Dim sFilePath As String
sFilePath = sAttachmentFolder & "\" & sFileName
If fso.fileexists(sFilePath) Then
MsgBox "Cannot save attachment " & lAttachmentIndex & vbCr _
& "File already exists: " & vbCr _
& sFilePath, vbExclamation + vbOKOnly
Else
If MsgBox("Saving atachment " & lAttachmentIndex & "?" & vbCr _
& "Save location: " & vbCr & sFilePath, _
vbQuestion + vbOKCancel) = vbOK Then
' Save the attachment to the temporary folder
oAttachment.SaveAsFile (sFilePath)
Dim sAttachmentName As String
sAttachmentName = fso.getfilename(sFilePath)
Dim lAttachmentLength As Long
lAttachmentLength = fso.getfile(sFilePath).size
Dim sURL As String
sURL = "file://" & Replace(sFilePath, "\", "/")
MsgBox "Attachment " & lAttachmentIndex _
& " saved as: " & sAttachmentName & vbCr _
& "Size: " & lAttachmentLength & vbCr _
& "URL = " & sURL, _
vbInformation + vbOKOnly
End If
End If
End If
Next lAttachmentIndex
End If
End Sub
As you will see, the SaveMessageAttachments() subroutine correctly saves the file to the filesystem, with the proper file name. However, Outlook dialogs (as well as when trying to write the attachment file name or URL to the message body in VBA) will always render the file names having accents differently. Please give it a try with an Outlook message having an attachment named e.g. "à présent.txt").
What is strange, however, is that if I try to paste sURL in the message body, although the URL is incorrectly written (2 character decomposition of accented letters) Outlook seems to find and open the file.
How can I transform this accented string (sAttachmentName) with VBA in order to correctly paste it ("à présent.txt" instead of "a` pre´sent.txt") into the message body?

Export Access query results to csv

I have an access database which manipulates data from a Magento e-commerce store, reformats the data and (hopefully!) spits out a CSV file which can then be imported into ebay Turbolister for mass upload to eBay.
I have got as far as creating a query which correctly lays out the data into the format required by Turbolister.
My issues are various (including some which appear to be related to Access' handling of large field contents), however the crux of my problem is that I am struggling to get working a simple script which exports the query results as a properly formatted CSV (including doubling up on double quotes where required inside a text value i.e. if the value itself contains quotes which need to be retained).
The DoCmd.TransferText solution throws an error related to field size ('the field is too small to accept the amount of data you attempted to add') so thats no good.
Has anyone got a good working CSV export routine in VBA that they can suggest?
Cheers
This is an old function I sometimes used to use, it allows you to specify the delimeter, it also checks the data it's outputting and if it can't be evaluated to either a date or a numeric etc, then it uses double quotes:
Public Function ExportTextDelimited(strQueryName As String, strDelimiter As String)
Dim rs As Recordset
Dim strHead As String
Dim strData As String
Dim inti As Integer
Dim intFile As Integer
Dim fso As New FileSystemObject
On Error GoTo Handle_Err
fso.CreateTextFile ("C:\Untitled.csv")
Set rs = Currentdb.OpenRecordset(strQueryName)
rs.MoveFirst
intFile = FreeFile
strHead = ""
'Add the Headers
For inti = 0 To rs.Fields.Count - 1
If strHead = "" Then
strHead = rs.Fields(inti).Name
Else
strHead = strHead & strDelimiter & rs.Fields(inti).Name
End If
Next
Open "C:\Untitled.csv" For Output As #intFile
Print #intFile, strHead
strHead = ""
'Add the Data
While Not rs.EOF
For inti = 0 To rs.Fields.Count - 1
If strData = "" Then
strData = IIf(IsNumeric(rs.Fields(inti).value), rs.Fields(inti).value, IIf(IsDate(rs.Fields(inti).value), rs.Fields(inti).value, """" & rs.Fields(inti).value & """"))
Else
strData = strData & strDelimiter & IIf(IsNumeric(rs.Fields(inti).value), rs.Fields(inti).value, IIf(IsDate(rs.Fields(inti).value), rs.Fields(inti).value, """" & rs.Fields(inti).value & """"))
End If
Next
Print #intFile, strData
strData = ""
rs.MoveNext
Wend
Close #intFile
rs.Close
Set rs = Nothing
'Open the file for viewing
Application.FollowHyperlink "C:\Untitled.csv"
Exit Function
Handle_Err:
MsgBox Err & " - " & Err.Description
End Function
It may need a couple of tweaks as I've taken out some bits which were only relevant to my particular case but this may be a starting point.