6
\$\begingroup\$

Following up on @Vogel612's friendly advice from the vba-rubberducking chat room, I am posting my working code for open review. Thanks also to @Mat'sMug for the help!

This will be my first task that I have completely automated via batch file scheduling, so I have included some spaces to pass error messages to the vbscript and batch file that will execute these macros. If some of the error handling seems a little excessive, it's because it is a zealous attempt by me to prevent any possible issues so that I am trusted to automate additional tasks via the scheduler in the future.


Part 1 is simply in charge of changing the list separator and quitting Excel so that Excel can be re-opened with the new list separator active.

Option Explicit

Private Declare Function SetLocaleInfo _
Lib "kernel32" Alias "SetLocaleInfoA" ( _
ByVal Locale As Long, _
ByVal LCType As Long, _
ByVal lpLCData As String) As Boolean

Private Declare Function GetUserDefaultLCID% Lib "kernel32" ()

Private Const LOCALE_SLIST = &HC
Private Const LOCALE_NAME_MAX_LENGTH = 85
Private Const LOCALE_NAME_USER_DEFAULT = vbNullString

'Get Locale Info
Private Declare Function GetLocaleInfoEx _
Lib "kernel32" ( _
ByVal lpLocaleName As String, _
ByVal LCType As Long, _
ByVal lpLCData As String, _
ByVal cchData As Long) As Long

Private Declare Function GetLastError Lib "kernel32" () As Long

Sub M1DelimiterSetup()

Dim lngTryAgainCtr As Long
Dim strBuffer As String
Dim strListSeparator As String
Dim lpLCData As String
Dim Long1 As Long

    lngTryAgainCtr = 0

TryAgain:
    lngTryAgainCtr = lngTryAgainCtr + 1

    'Change delimiter to pipe
    Call SetLocaleInfo(GetUserDefaultLCID(), LOCALE_SLIST, "|")

    'Check to make sure setting separator as pipe worked correctly
    strBuffer = String$(85, 0)
    Long1 = GetLocaleInfoEx(LOCALE_NAME_USER_DEFAULT, LOCALE_SLIST, lpLCData, 0)

    strListSeparator = String$(Long1, 0)
    Long1 = GetLocaleInfoEx(LOCALE_NAME_USER_DEFAULT, LOCALE_SLIST, strListSeparator, Long1)

    If Instr(strListSeparator, "|") = 0 Then
        If lngTryAgainCtr < 3 Then
            GoTo TryAgain
        Else
            If GetLocaleInfoEx(LOCALE_NAME_USER_DEFAULT, LOCALE_SLIST, strListSeparator, Long1) <> 0 Then Debug.Print GetLastError
            'pass part 1 error message
            'need error message for if run actively instead of part of script
        End If
    End If

    'Close workbook to allow Excel to reset its memory of delimiter
    'Show alerts if more workbooks open
    If Workbooks.Count = 1 Then Application.DisplayAlerts = False
    Application.Quit

End Sub

Part 2 downloads.

Option Explicit

'Set Locale Info
Private Declare Function SetLocaleInfo _
Lib "kernel32" Alias "SetLocaleInfoA" ( _
ByVal Locale As Long, _
ByVal LCType As Long, _
ByVal lpLCData As String) As Boolean

Private Declare Function GetUserDefaultLCID% Lib "kernel32" ()

Private Const LOCALE_SLIST = &HC
Private Const LOCALE_NAME_MAX_LENGTH = 85
Private Const LOCALE_NAME_USER_DEFAULT = vbNullString

'Get Locale Info
Private Declare Function GetLocaleInfoEx _
Lib "kernel32" ( _
ByVal lpLocaleName As String, _
ByVal LCType As Long, _
ByVal lpLCData As String, _
ByVal cchData As Long) As Long

Private Declare Function GetLastError Lib "kernel32" () As Long

Sub M2ProviderFileAutomation()
'
' M1ResponseSort Macro
'
' Keyboard Shortcut: Ctrl+Shift+Q
'
Dim strProvFileSaveLoc As String 'Full File Name
Dim strProvFileUnzipped As String 'Location of Text File after Unzipping
Dim strProvFileEITcsv As String 'Location in EIT folder where csv is saved
Dim strProvFileWebAddr As String 'url of file being downloaded
Dim Object1 As Object 'Shell Application
Dim Object2 As Object 'File system object
Dim Int1 As Integer 'Input file number (system-assigned number for file management)
Dim oXMLHTTP As Object
Dim oResp() As Byte
Dim Variant1 As Variant
Dim Variant2 As Variant
Dim Long1 As Long
Dim strBuffer As String
Dim strListSeparator As String
Dim lpLCData As String

    'Check to make sure Part 1 ran correctly and separator is pipe
    strBuffer = String$(85, 0)
    Long1 = GetLocaleInfoEx(LOCALE_NAME_USER_DEFAULT, LOCALE_SLIST, lpLCData, 0)

    strListSeparator = String$(Long1, 0)
    Long1 = GetLocaleInfoEx(LOCALE_NAME_USER_DEFAULT, LOCALE_SLIST, strListSeparator, Long1)

    If Instr(strListSeparator, "|") = 0 Then
        If GetLocaleInfoEx(LOCALE_NAME_USER_DEFAULT, LOCALE_SLIST, strListSeparator, Long1) <> 0 Then Debug.Print GetLastError
        'Pass Error Message about it not being ready from part 2
        'need error message for if run actively instead of part of script
        GoTo Cancel
    End If

    'Makes things go faster
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    'Save the provider file
    strProvFileWebAddr = "http://example.webaddress.com/filename.zip"
    strProvFileSaveLoc = "\\example\completepath.zip"
    strProvFileUnzipped = "\\exmple\completepath.txt"

    'You can also set a ref. to Microsoft XML, and Dim oXMLHTTP as MSXML2.XMLHTTP
    Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP")
    oXMLHTTP.Open "GET", strProvFileWebAddr, False 'Open socket to get the website
    oXMLHTTP.Send 'send request

    'Wait for request to finish
    Do While oXMLHTTP.readyState <> 4
        DoEvents
    Loop

    oResp = oXMLHTTP.responseBody 'Returns the results as a byte array

    'Create local file and save results to it
    Int1 = FreeFile()
    If Dir(strProvFileSaveLoc) <> "" Then Kill strProvFileSaveLoc
    Open strProvFileSaveLoc For Binary As #Int1
    Put #Int1, , oResp
    Close #Int1

    'Clear memory
    Set oXMLHTTP = Nothing

    'Unzip zipped provider file
    Set Object1 = CreateObject("Shell.Application")
    'Has to be variants, can't be strings
    Variant1 = "\\sample\directory\"
    Variant2 = strProvFileSaveLoc
    Object1.Namespace(Variant1).CopyHere Object1.Namespace(Variant2).items
    On Error Resume Next
    Set Object2 = CreateObject("scripting.filesystemobject")
    Object2.DeleteFolder Environ("Temp") & "\Temporary Directory*", True
    On Error GoTo 0

    'Excel changes to provider file
    Workbooks.OpenText strProvFileUnzipped, DataType:=xlDelimited, _
    TextQualifier:=xlTextQualifierDoubleQuote, Other:=True, Otherchar:="|", FieldInfo:=Array(Array(1, 2), _
    Array(2, 2), Array(3, 2), Array(4, 2), Array(5, 2), Array(6, 2), Array(7, 2), Array(8, 2), Array(9, 2), _
    Array(10, 2), Array(11, 2), Array(12, 2), Array(13, 2), Array(14, 2), Array(15, 2), Array(16, 2), _
    Array(17, 2), Array(18, 2), Array(19, 2), Array(20, 2), Array(21, 2), Array(22, 2), Array(23, 2), _
    Array(24, 2))

    'Delete Headers
    ActiveWorkbook.Sheets(1).Rows(1).Delete
    'Replace double quotes with single quotes in Columns B and C
    ActiveWorkbook.Sheets(1).Columns("B:C").Replace What:="""", Replacement:="'", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

    strProvFileEITcsv = "\\sample\directory\" & Format(Now, "mmddyy") & "FileName.csv"
    ActiveWorkbook.SaveAs Filename:=strProvFileEITcsv, FileFormat:=xlCSV, local:=True
    'Don't have permission to copy from EIT folder
    ActiveWorkbook.SaveAs Filename:="\\other\directory\" & Format(Now, "mmddyy") & "Filename.csv", FileFormat:=xlCSV, local:=True
    ActiveWorkbook.Close False

    'Change delimiter back to comma
    Call SetLocaleInfo(GetUserDefaultLCID(), LOCALE_SLIST, ",")

    'Move zip file to archive
    Name strProvFileSaveLoc As "\\archive\directory\" & Format(Now, "mm.dd.yy") & ".zip"
    'Move txt file to archive
    Name strProvFileUnzipped As "\\archive\directory\" & Format(Now, "mmddyy") & "Filename.txt"

    'Cleanup nested folders from unzipped web file
    RmDir "\\sample\path of third nested folder\"
    RmDir "\\sample\path of second nested folder\"
    RmDir "\\sample\path of first nested folder\"
    RmDir "\\sample\path of outer folder\"

    MsgBox "File done processing."

    Application.ScreenUpdating = True
    Application.Calculation = xlAutomatic

    'Show alerts if more workbooks open
    If Workbooks.Count = 1 Then Application.DisplayAlerts = False
    Application.Quit

Cancel:

End Sub
\$\endgroup\$
2
\$\begingroup\$

The API is a fickle mistress. Don't piss it off.

I'll start off by repeating my advice from your Stack Overflow question: follow the correct usage conventions when you use API functions. This is why:

WARNING: This will almost certainly crash the VBE. It will most likely crash Excel. There is an outside chance it will crash Windows. Save all your work first.

Private Const LOCALE_NAME_MAX_LENGTH = 85
Private Const LOCALE_SLIST = &HC
Private Const LOCALE_NAME_USER_DEFAULT = vbNullString

Private Declare Function GetLocaleInfoEx Lib "kernel32" ( _
    ByVal lpLocaleName As String, ByVal LCType As Long, ByVal lpLCData As String, _
    ByVal cchData As Long) As Long

Private Sub Example()
    Dim lpLCData As String
    Dim bufferSize As Long

    '1 sounds about right for a bufferSize...
    bufferSize = 1
    lpLCData = String(retVal, bufferSize)
    'Oops - totally forgot about that constant...
    GetLocaleInfoEx LOCALE_NAME_USER_DEFAULT, LOCALE_SLIST, lpLCData, _
                    LOCALE_NAME_MAX_LENGTH

    Debug.Print "You'll most like never find out that the locale is " & lpLCData
End Sub

After the first couple of times you do that it starts to sink in for a developer. Completely different story for the user that stumbles into a weird situation where you get a bad value and immediately pass it into another API call.

GetLocaleInfoEx is relatively resilient in that it will fail if the buffer size you tell it that you have available for it is too small. But it will happily overrun a buffer if you pass a bad length parameter. When you start passing things like window handles and pointers, you can really have the wheels come off. C and C++ are very different beasts from VBA, and that's what you're dealing with on a kernel32.dll call.

So, follow the documented best practices for calling the function. Your potential issue is here (line continuations added to avoid side-scrolling):

Long1 = GetLocaleInfoEx(LOCALE_NAME_USER_DEFAULT, LOCALE_SLIST, lpLCData, 0)
strListSeparator = String$(Long1, 0)
Long1 = GetLocaleInfoEx(LOCALE_NAME_USER_DEFAULT, LOCALE_SLIST, _
                        strListSeparator, Long1)

If InStr(strListSeparator, "|") = 0 Then
    If GetLocaleInfoEx(LOCALE_NAME_USER_DEFAULT, LOCALE_SLIST, _ 
                  strListSeparator, Long1) <> 0 Then Debug.Print GetLastError
        If lngTryAgainCtr < 3 Then
            GoTo TryAgain

From the documentation "The function returns 0 if it does not succeed". Let's step through this:

  1. For the sake of argument, lets assume that the function fails. Your first line sets Long1 to zero.
  2. Your second line ignores the return value and does this: String$(0, 0). That gets you a vbNullString, which VBA will dutifully marshal as a null pointer.
  3. You immediately pass the null pointer back into the API as a parameter. Luckily, the kernel developers walled against that (although never make that assumption). So your second call should return ERROR_INVALID_PARAMETER.
  4. In the meantime, absolutely nothing has happened to your strListSeparator variable, because if GetLocaleInfoEx tried to write to your null pointer, it would have done the same thing as my code above (all the wheels coming off).
  5. That means your next test is this: If InStr(vbNullString, "|") = 0 Then, which will obviously return 0, meaning...
  6. ...you repeat the exact same sequence of events 2 more times.

That said, a couple other points in addition to @Raystafarian's good advice:

Others:

  1. Get rid of the GoTo's. There isn't anything you can do with a GoTo that you can't do with different a code structure that would be much more readable.
  2. Don't loop based on an error condition unless you do something to attempt to recover from the error. Making the exact sequence of calls 3 times is almost exactly as likely to fail as running through the same sequence of calls once. There is no reason to expect that the locale is going to magically change unless the user realizes immediately what happened and has incredibly awesome reflexes.
  3. strBuffer is only assigned to, then never used in both M2ProviderFileAutomation() and M1DelimiterSetup().
  4. In addition, it is sized using with a hard-coded value of 85 after you assigned Private Const LOCALE_NAME_MAX_LENGTH = 85 (which you shouldn't use anyway per the documentation linked above).
  5. You repeat not only all of the code for getting the local delimiter, but the function declaration as well. DRY and extract that code to it's own function. You wouldn't want to fix the calling sequence in one and forget the other.
  6. On a similar note, I'd extract some other functions out too. It's a lot easier to debug a function that you can see the entirety of in the IDE, and it encourages reuse as opposed to reimplementation (see 5).
  7. The Cancel: label is never referenced. Don't do it. If you have the urge to type GoTo Cancel, type Exit Sub instead. If you intend to use it as an error handler, you should ensure that the environment gets reset on errors, so Application.ScreenUpdating = True and Application.Calculation = xlAutomatic should be inside the error handler.
  8. Using ActiveWorkbook is dangerous. What happens if another workbook opens while the code is running? This is even more dangerous when 2 calls to ActiveWorkbook have a DoEvents call in between. This yields to whatever Excel feels like doing with to the ActiveWorkbook. Get references to your Excel objects and use them instead.
  9. Environ("Temp") returns a Variant, which is implicitly being cast to a String, as does Dir(strProvFileSaveLoc). Dir$ and Environ$ avoid spurious casting. Since you're already working with the API, you might consider GetTempPath - it's generally more reliable.
  10. You discard the return value of SetLocaleInfo instead of checking to make sure it succeeded (see the discussion at the start).
  11. GetUserDefaultLCID is deprecated. You should be using GetUserDefaultLocaleName unless you're targeting XP or earlier. Which you aren't, because you call GetLocaleInfoEx which requires Vista or better later.
  12. You should also never chain API calls like Call SetLocaleInfo(GetUserDefaultLCID(), LOCALE_SLIST, ","). That is asking for demanding trouble. Refer back to the discussion at the start.
\$\endgroup\$
  • \$\begingroup\$ That is great advice and good to know, I usually never use API calls myself, so it's all foreign to me. +1 \$\endgroup\$ – Raystafarian Apr 22 '16 at 11:30
  • \$\begingroup\$ Cannot upvote this enough nor thank @Vogel612 enough for advising that I post my code here. I was definitely following my usual learning template of "if it's too hard to understand right away, poke at some working examples and learn that way". It seems that by the time I've burrowed down to the API level, this is no longer an appropriate way to learn - I'll study up. Thank you very very much! \$\endgroup\$ – puzzlepiece87 Apr 22 '16 at 15:17
  • \$\begingroup\$ I wasn't able to find my expected equivalent on SetLocaleInfo before. I thought there would be a SetLocaleInfoEx. Searching now, I see if you find the page that corresponds to later versions of office, they do get away from GetUserDefaultLCID, though curiously they recommend using LOCALE_USER_DEFAULT. See here: msdn.microsoft.com/en-us/library/windows/desktop/… \$\endgroup\$ – puzzlepiece87 Apr 22 '16 at 15:25
  • \$\begingroup\$ @Comintern, still brushing up on my API documentation and parsing through your answer. From the main issue you highlighted, I understand it better now. Would you say an appropriate and complete way to solve that issue (the one before the "Others" section) would be to create a new test If Long1 = 0before strListSeparator = String$(Long1, 0) and capture/exit sub the error that way? Or would more be needed to resolve the issue you highlighted appropriately and completely? \$\endgroup\$ – puzzlepiece87 Apr 25 '16 at 14:57
  • \$\begingroup\$ @puzzlepiece87 - Yep, that would be testing for the error condition. If the first call doesn't succeed, you shouldn't make the second call because first, you don't know what the buffer size required should be and second, it likely means that one of the parameters or flags is not set correctly. \$\endgroup\$ – Comintern Apr 25 '16 at 17:20
3
\$\begingroup\$

Okay, I'll say it - variable names. It is awesome that you declared all of them with a type and used Option Explicit. But, the naming leaves something to be desired.

Some of them are good where others are too cryptic or don't have inherent meaning. By describing what they are, you reduce the likelihood of future-you getting confused.

Part 1

Private Declare Function SetLocaleInfo is a good description, as is Locale.

But LCType - is that localeType? And lpLCData - I can't tell what type of data that should be.

Your Const are good - but why do you have a Const = vbNullString? That's already a constant.

Private Declare Function GetLocaleInfoEx - what does this do? The Ex means something - why not use the full name? And lpLocaleName and cchData - what are those?

And why is a Data variable a long? Seems counter-intuitive when reading the function.

You don't need to use the prefix str or any other prefix (Hungarian Notation) if your variables have good naming, so you can drop those. Long1 - I find it bad practice to not only use a number in a variable, but also a system reserved name. What does it do? Looks like it is positionOfListSeparator, right?

Also Standard VBA naming conventions have camelCase for local variables and PascalCase for other variables and names. Your constants are great, but some of your locals could be adjusted.

Part 2

Again, the prefixes could be removed and the variables would be good descriptions - but why shorten Address to Addr - you're not paying per character so use them!

Dim Object1 As Object 'Shell Application
Dim Object2 As Object 'File system object
Dim Int1 As Integer 'Input file number (system-assigned number for file management)

Seems like those variables could have names AND the comments could be eliminated in one fell swoop.

Dim oXMLHTTP As Object
Dim oResp() As Byte
Dim Variant1 As Variant
Dim Variant2 As Variant

I have no idea what a Variant1 and Variant2 are when you declare them, so how would I be able to tell how they are different further down? You catch the drift by now.

\$\endgroup\$
  • \$\begingroup\$ Upvoted, great feedback, thank you! Would it be appropriate to ask questions/point things out about your feedback, or best to take it as it is? \$\endgroup\$ – puzzlepiece87 Apr 21 '16 at 14:24
  • \$\begingroup\$ No, it's always great to respond to feedback assuming it doesn't get too long or warrant a new question \$\endgroup\$ – Raystafarian Apr 21 '16 at 15:06
  • \$\begingroup\$ Feedback: To most of your questions about the naming and var types, my answer is that I used the naming conventions from the msdn articles for those api calls, i.e. msdn.microsoft.com/en-us/library/windows/desktop/…. I find this to be helpful for future Googling since I didn't write those api calls myself. \$\endgroup\$ – puzzlepiece87 Apr 21 '16 at 15:20
  • 1
    \$\begingroup\$ I, uh, it's very controversial. \$\endgroup\$ – Raystafarian Apr 21 '16 at 15:23
  • 1
    \$\begingroup\$ Ah, I was asking more about my use of disposable variables than Systems Hungarian notation, but thanks for waking me up to the controversy. I read a ton of stuff on it just now. \$\endgroup\$ – puzzlepiece87 Apr 21 '16 at 16:28

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.