Open/Close Operation Equivalence VB6 / VB.NET - vb.net

I am working on converting parts of a VB6 Project to VB.Net and there are some code segments I am having issues with because I can't seem to find alternatives for the VB6 code in VB.Net. Here is the code block in question right now:
Public Sub ProcessError(ByVal strModule As String, ByVal strProcedure As String, _
ByVal strDescription As String, ByVal bLogError As Boolean, _
ByVal bShowError As Boolean, Optional ByVal strMsg As String)
On Error GoTo 100
Dim intFile As Integer: Dim strPathName As String
strPathName = AddBackSlash(gsLogPath) & gsErrLogName
If bLogError = True Then
If GetFileSize(strPathName) > gcuMaxLogFileSize Then
Call CopyFile(strPathName, strPathName & ".bak")
Call DeleteFile(strPathName)
End If
intFile = FreeFile
Open strPathName For Append As #intFile
Write #intFile, Format(Now, "MMM-DD-YYYY HH:MM:SS AMPM"), strModule, strProcedure, strDescription)
Close #intFile
End If
If bShowError Then
Call Prompt("Error occurred in " & strModule & vbCrLf & "Error Description :" & strDescription, 1, vbRed)
End If
Exit Sub
100:
Close #intFile
End Sub
So the lines I am having issue with are:
Open strPathName For Append As #intFile
Write #intFile
Close #intFile
I understand I should probably be using the StreamWriter object in place of these, but what throws me off is the Error section. If an error is thrown and it goes to the 100 mark, how would Close #intFile work if it hasn't been opened or created yet?
For most of the other conversion annoyances I've had with porting this over this one has been confusing me the most, so any help is appreciated. Thanks for your time.

This fixes the errors, and also updates a lot of the code to use styles and APIs more typical for modern VB.Net. For this to work as-is, make sure there is an Imports System.IO directive at the top of the file.
Public Sub ProcessError(ByVal ModuleName As String, ByVal ProcedureName As String, _
ByVal Description As String, ByVal LogError As Boolean, _
ByVal ShowError As Boolean, Optional ByVal Message As String)
If LogError Then
Dim logFile As New FileInfo(Path.Combine(gsLogPath, gsErrLogName))
If logFile.Length > gcuMaxLogFileSize Then
logFile.MoveTo(logFile.FullName & ".bak")
End If
Try
File.AppendAllText(PathName, String.Format("{0:d},""{1}"",""{2}"",""{3}""", DateTime.Now, ModuleName, ProcedureName, Description))
Catch
End Try
End If
If ShowError Then
MsgBox(String.Format("Error occurred in {0}{1}Error Description:{2}", ModuleName, vbCrLf, Description))
End If
End Sub
One thing worth pointing out here is the style guidelines published by Microsoft for VB.Net now explicitly recommend against hungarian type-prefixes.

If you just have one line to write to, you can use the build-in method that does all the work for you.
Dim inputString As String = "This is a test string."
My.Computer.FileSystem.WriteAllText(
"C://testfile.txt", inputString, True)
More help here: https://learn.microsoft.com/en-us/dotnet/visual-basic/developing-apps/programming/drives-directories-files/how-to-append-to-text-files?view=netframework-4.7.2

Related

VB.NET / First row missing when writing to a CSV file

Wrote a program that writes name, postcode, device type, damage type to a CSV file and for some reason it misses the first row.
Thanks
Sub fileWriting(ByVal file As String, ByVal name As String, ByVal postcode As String, ByVal dmgType As String, ByVal devType As String) ' writing to files function
Dim ObjStreamWriter As StreamWriter
ObjStreamWriter = New StreamWriter(file, True)
ObjStreamWriter.Write(name & ",")
ObjStreamWriter.Write(postcode & ",")
ObjStreamWriter.Write(dmgType & ",")
ObjStreamWriter.WriteLine(devType)
ObjStreamWriter.Close()
End Sub
One point on the code above:
ObjStreamWriter = New StreamWriter(file, True)
will append to an existing file, if the file already exists. Therefore the text you're appending may exist further down in the file depending how much you've already written.
Additionally, StreamWriter implements IDisposable so the preferred method of implementation is to instantiate it in a Using block, if you're immediately closing the object.
Using ObjStreamWriter = New StreamWriter(file, True)
ObjStreamWriter.Write(name & ",")
ObjStreamWriter.Write(postcode & ",")
ObjStreamWriter.Write(dmgType & ",")
ObjStreamWriter.WriteLine(devType)
End Using
I'm not sure if these will fix your issue as there's insufficient code to really determine that, but if you're having issues with text not flushing, this ensures that you're automatically doing everything needed to properly close the file. Normally that'd be text missing from the end of the file, not the start, but it might help.

Excel VBA bug accessing HelpFile property from macro-disabled instance?

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

File extension validation

This searches for the end of a file name removes it's current file type of .docm and converts it to a .docx. Works great.
ActiveDocument.SaveAs2 Left(ActiveDocument.Name, InStrRev(ActiveDocument.Name, ".") - 1), WdSaveFormat.wdFormatXMLDocument
However, I noticed a little bug. If there is a . in the file name, it finds that first and obviously creates a file that is incorrect.
For example:
TestFileV1.2AlexTest.docm
Becomes the file
TestFileV.2AlextTest Where the new file type is a .2ALEXTEST file.
Kind of a funny error, but still a bug none the less.
Best course of action for validation?
Thanks!
Try the VBA.Strings.Split() function, which splits a string into an array.
Split the File name on '.' and the last element in the array will be your extension:
Public Function GetExtension(FileName As String) As String
'Returns a file's extension
' This does not go to the filesystem and get the file:
' The function parses out the string after the last '.'
' Useful for situations where a file does not yet exist
' Nigel Heffernan Excellerando.Blogspot.com
' **** THIS CODE IS IN THE PUBLIC DOMAIN ****
'Print GetExtension("C:\Temp\data.txt1.docx")
'Returns docx
Dim arrayX() As String
Dim iLast As Integer
arrayX = Split(FileName, ".")
iLast = UBound(arrayX)
GetExtension = arrayX(iLast)
Erase arrayX
End Function
If you don't care about readability, the quick-and-dirty answer is:
strExt = Split(strFile, ".")(UBound(Split(strFile, ".")))
However... I think you're looking for something more sophisticated than a string parser to extract the file extension.
Are you actually looking to validate the file extension?
I'm not coding up a registry lookup for the ShellExt application command to open your file, but I had a closely-related issue to yours a year or two ago, when I needed to populate a file dialog's filter list with a list of arbitrary file extensions.
It doesn't 'validate' as such, but unknown extensions will return a string containing 'unknown file type', and you can test for that:
VBA and the Registry: Returning a File Type from a File Extension
Public Function GetExtensionType(strExt As String) As String
' Return a file extension type descriptor, if the OS knows it
' Parses out the string after the last "." and reads the registry
' GetExtensionType("txt") Returns 'Text Document'
' GetExtensionType("SystemORA.user.config") 'XML Configuration File'
' GetExtensionType("Phishy.vbs") 'VBScript Script File'
' Nigel Heffernan Excellerando.Blogspot.com
' **** THIS CODE IS IN THE PUBLIC DOMAIN ****
On Error GoTo ErrSub
Dim strType As String
Dim strTyp1 As String
Dim strTyp2 As String
strExt = Trim(strExt)
' Set a default return: if an error is raised, return this value
GetExtensionType = Trim(strExt & " (unknown file type)")
strExt = Split(strExt, ".")(UBound(Split(strExt, "."))) '
If strExt = "" Then
Exit Function
End If
With CreateObject("WScript.Shell")
' This will go to error if there's no key for strExt in HKCR
strTyp1 = .RegRead("HKCR." & strExt & "\")
If strTyp1 = "" Then
strType = strExt & " File"
Else
' This value isn't very readable, eg: Access.ACCDEFile.14
' But we can use it to retrieve a descriptive string:
strTyp2 = .RegRead("HKCR\" & strTyp1 & "\")
If strTyp2 = "" Then
' So we didn't get a descriptive string:
' Parse some readability out of strType1:
strType = strTyp1
strType = Replace(strType, "File", " File")
strType = Replace(strType, ".", " ")
Else
strType = strTyp2
End If
End If
End With
If strType <> "" Then
GetExtensionType = strType
End If
ExitSub:
Exit Function
ErrSub:
Resume ExitSub
End Function
I made it error-tolerant but I didn't bother idiot-proofing it because someone, somewhere, is building a better idiot; and it's entirely possible that the user was actually right insofar as there really are files called that, and my system didn't have a registry entry for the file type in question.
There is an obvious source of errors in the code: GetExtensionType("docx") will give you 'Microsoft Word Document' on an English-Language workstation. If your user base are working with other languages and locales, they will see the descriptive name 'Microsoft Word Document' in their chosen language; and any validation logic you've coded up will fail to match that string (unless, of course, your string literals are internationalised in a conditional compiler block).
So any validation against a predefined application name or file type needs to be at the language-independent layer of the registry, using 'strTyp1' from the root instead of the locale-dependent strings passed into 'strTyp2'.
Use the FileSystemObject from the Scripting Runtime - it has a .GetBaseName() method to extract the basename from a file path:
'Early bound (reference to Microsoft Scripting Runtime):
Dim fso As New FileSystemObject
ActiveDocument.SaveAs2 fso.GetBaseName(ActiveDocument.Name), WdSaveFormat.wdFormatXMLDocument
'Late bound:
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
ActiveDocument.SaveAs2 fso.GetBaseName(ActiveDocument.Name), WdSaveFormat.wdFormatXMLDocument
You can also retrieve the extension with the .GetExtensionName() method, the path with .GetParentFolderName(), and the drive letter with GetDriveName() (which also works with UNC paths).
If you need to find the registered name of the extension in the current Windows install, you can either use the registry method #Nile answered with or an API call to AssocQueryStringA:
Const ASSOCSTR_FRIENDLYDOCNAME = 3
Private Declare Function AssocQueryString Lib "shlwapi.dll" _
Alias "AssocQueryStringA" ( _
ByRef Flags As Long, _
ByVal str As Long, _
ByVal pszAssoc As String, _
ByVal pszExtra As String, _
ByVal pszOut As String, _
ByRef pcchOut As Long) As Long
Sub Main()
Dim buffer As String
buffer = String$(255, " ")
Dim hresult As Long
hresult = AssocQueryString(0, ASSOCSTR_FRIENDLYDOCNAME, ".docm", _
vbNullString, buffer, 255)
If hresult = 0 Then
'Should be something like "Microsoft Word Macro-Enabled Document"
Debug.Print Trim$(buffer)
End If
End Sub
Note that you can also retrieve addition information about the associated file type by passing different values for the str parameter. See the ASSOCSTR enumeration.

How to create a shortcut?

I need to create shortcuts for selected files within selected folders. On several sites (including stackoverflow) I found the following code:
Private Sub MakeShortcut(ByVal File As String, ByVal ShortcutFolder As String, ByVal Name As String, ByVal WorkDirectory As String)
Dim WshShell As Object = CreateObject("WScript.Shell")
Dim NewShortcut As Object = WshShell.CreateShortcut(ShortcutFolder & "\" & Name & ".lnk")
NewShortcut.TargetPath = File
NewShortcut.WindowStyle = 1
NewShortcut.IconLocation = File & ",0"
NewShortcut.WorkingDirectory = WorkDirectory
NewShortcut.Save()
End Function
Of course I added a reference to Interop.IWshRuntimeLibrary.dll to my Project and "Imports IWshRuntimeLibrary" within the 'general' section of the form.
Nevertheless I do get the message "Option Strict dissallows late binding" for all appearances of "whshell." and "Newshortcut."
Why am I getting this error and how can I fix it?

VB.NET code to reverse file contents

I have wrote some code in Visual Basic 6 which reverses the contents of a file, however I have problems converting this code to .NET as VB.NET only reads the text part of the file. Can someone please show me the VB.NET equivalent of this code. I believe it will not only help me, but the whole SOF community :).
Public Function NeutralizeFile(strFile As String, strOut As String) As Boolean
On Error GoTo ErrDelete
Dim File As String
Open strFile For Binary As #1
File = Space(LOF(1))
Get #1, , File
Close #1
File = StrReverse(File)
Open strOut For Binary As #1
Put #1, , File
Close #1
Kill strFile
ErrDelete:
End Function
Public Sub NeutralizeFile(ByVal PathIn As String, ByVal PathOut As String)
Try
Dim data() As Byte = IO.File.ReadAllBytes(PathIn)
Array.Reverse(data)
IO.File.WriteAllBytes(PathOut, data)
Catch ex As Exception
MsgBox("Error")
End Try
End Sub
Try this
Public Sub NeutralizeFile(strFile As String, strOut As String)
Try
Dim StreamReader1 As New IO.StreamReader(strFile)
Dim StreamWriter1 As New IO.StreamWriter(strOut)
StreamWriter1.Write(StrReverse(StreamReader1.ReadToEnd))
StreamReader1.Close()
StreamReader1.Dispose()
StreamWriter1.Close()
StreamWriter1.Dispose()
IO.File.Delete(strFile)
Catch ex As Exception
MsgBox("Error")
End Try
End Sub