-
Nov 2nd, 2020, 07:27 PM
#1
Thread Starter
New Member
Adapt excel macro to accept dir.
I have the following code (that I did not write) and I need t adapt it to accept a directory instead of a single file. I know no VBA. I know the first "function" shows the dialog however I've tried using Application.OpenFolder() but it just threw an exception saying it failed. Any help would be appreciated.
https://pastebin.com/9N0Xkt3W
-
Nov 2nd, 2020, 07:39 PM
#2
Re: Adapt excel macro to accept dir.
Post the VBA code here (inside CODE tags) so we can see it without needing to access another web site.
-
Nov 2nd, 2020, 07:44 PM
#3
Thread Starter
New Member
Re: Adapt excel macro to accept dir.
Its too long, but here is some of it.
Code:
Dim speedUnits As String
Dim TypeExitingVehicle As String
Dim TypeZoneStatistics As String
Dim Classes(6) As Integer ' Limited to 6 classes for now
Dim SavedClasses(6) As Integer
Dim NumClasses As Integer
Private Sub Auto_Open()
Call SetupClasses(False)
For i = 0 To 5
SavedClasses(i) = Classes(i)
Next i
End Sub
Sub ImportDataFile()
On Error GoTo ErrorHandler
TypeExitingVehicle = "ExitingVehicle"
TypeZoneStatistics = "ZoneStatistics"
#If Win32 Or Win64 Then
' Windows
' Prepare filename
Dim Fname As Variant
Dim sSaveDriveDir As String
Dim sPath As String
Dim sFilename As String
sSaveDriveDir = CurDir
sPath = ActiveWorkbook.Path
ChDrive (sPath)
ChDir (sPath)
Fname = Application.GetOpenFilename("Vision Data File (*.csv), *.csv, All files (*.*), *.*", 1, "Import Data")
If (Fname <> False) Then
sFilename = CStr(Fname)
'First make sure the selected file already exists
Set fs = CreateObject("Scripting.FileSystemObject")
If (Not fs.fileexists(sFilename)) Then
Call MsgBox("Specified file does not exist.", vbCritical, "Import Data")
ChDrive (sSaveDriveDir)
ChDir (sSaveDriveDir)
Exit Sub
End If
Call ImportVisionData(sFilename)
End If
ChDrive (sSaveDriveDir)
ChDir (sSaveDriveDir)
#Else
Call MsgBox("Vision Data Reporter does not yet run on a Mac.", vbOKOnly + vbInformation, "Import Data")
Exit Sub
' Mac - Must be Excel 2011 or higher
If (Val(Application.Version) > 14) Then
'Mac
'Dim sPath As String
'Dim sScript As String
'Dim sFilename As String
'Dim wBook As Workbook
'
'sPath = MacScript("return (path to documents folder) as String")
'' Or could be: sPath = "Macintosh HD:Users:UsernameHere:Desktop:TestFolder:"
'
'' If you want to filter for multiple files, change
'' {""com.microsoft.Excel.xls""} to
'' {""com.microsoft.excel.xls"",""public.comma-separated-values-text""}
'' if you want to filter on xls and csv files, for example.
'sScript = _
'"set applescript's text item delimiters to "","" " & vbNewLine & _
' "set theFiles to (choose file of type " & _
' " {""public.comma-separated-values-text""} " & _
' "with prompt ""Please select a file"" default location alias """ & _
' sPath & """ multiple selections allowed false) as string" & vbNewLine & _
' "set applescript's text item delimiters to """" " & vbNewLine & _
' "return theFiles"
'
'sFilename = MacScript(sScript)
'
'If sFilename <> "" Then
'
' ' Get the file name only and test to see if it is open.
' If (Application.Workbooks(sFilename) Is Nothing) Then
'
' ' Here do the import
' Call ImportVisionData(sFilename)
'
' Else
' ' File is already open #### THIS IS FROM SAMPLE CODE AND PROBABLY NOT NEEDED ########
' Call MsgBox("Specified file is already open and cannot be imported.", vbOKOnly + vbCritical, "Import Data")
' End If
'
'End If
Else
Call MsgBox("Vision Data Reporter for the Mac requires Excel 2011 or newer.", vbOKOnly + vbInformation, "Import Data")
End If
#End If
Exit Sub
ErrorHandler:
Call MsgBox("Data import did not complete1.", vbOKOnly + vbCritical, "Import Data")
End Sub
Private Sub ImportVisionData(sFilename As String)
On Error GoTo ErrorHandler
Dim fso As Object ' scripting.filesystemobject
Dim txtin As Object ' scripting.textstream
Dim data As String
Dim result As String
Dim MaxZones As Integer
Dim errorRow As Integer
Dim errorNum As Integer
Dim MaxAllowedErrors As Integer
Dim ttlrow As Long
Dim datarow As Long
Dim RDrow As Long
Dim tokens() As String
Dim NumZones As Integer
Dim ZoneIndex As Integer
Dim ZoneArray(16) As String
Dim CountsArray(16, 4) As Integer
Dim ClassArray(16, 6) As Integer ' 6 classes max
Dim SpdArray(16) As Long
Dim LngArray(16) As Long
Dim Dir As String
Dim DtTm As Date
Dim firstDay As Date
Dim startTime As Date
Dim endTime As Date
Dim startRange As Date
Dim endRange As Date
Dim InADateGap As Boolean
Dim NumDateGaps As Integer
Dim SkipDate As Date
Dim interval As Integer
Dim days As Integer
Dim NumOutputRecords As Long
Dim outrow As Long
Dim BinRecords As Integer
Dim NumLengths As Integer
Dim VehicleLength As Integer
' Additional variables for bike actuation
Dim BikeActRow As Integer ' sheet row integer
Dim CurrBikePres(16) As Boolean ' default value is false, bike zone presense
Dim CurrBikeCount(16) As Integer ' bike zone counter
Dim TotBikeCount(16) As Integer ' running total bike counter
' Initialize variables for bike actuation
BikeActRow = 1
outrow = 2
MaxAllowedErrors = 100
MaxZones = 16
NumZones = 0
InADateGap = False
NumDateGaps = 0
' If setup calls for skipping data, be sure user wants to do so
If (Not IsEmpty(Sheets("Setup").Range("SkipDate"))) Then
s = "Setup calls for skipping data older than " & Sheets("Setup").Range("SkipDate").Value & ". Continue?"
If (MsgBox(s, vbOKCancel + vbQuestion, "Clear Data") = vbCancel) Then
Exit Sub
End If
End If
SkipDate = Sheets("Setup").Range("SkipDate").Value
For r = 0 To 15
SpdArray(r) = 0
LngArray(r) = 0
For c = 0 To 3
CountsArray(r, c) = 0
Next c
For c = 0 To 5
ClassArray(r, c) = 0
Next c
Next r
' Prepare for classification
Call SetupClasses(True)
For i = 0 To 5
SavedClasses(i) = Classes(i)
Next i
If (AreClassesAscending() = False) Then
Call MsgBox("Classes are not ascending. You must correct the Vehicle Length Classes on the Setup tab before continuing.", vbOKOnly + vbCritical, "Update Reports")
Exit Sub
End If
' Time to delete any existing
' If anything in first row of data or in first header, delete. Otherwise, assume sheet is RawData is empty.
If (Sheets("RawData").Range("A1").Value <> "") Then
If (MsgBox("All existing imported data will be deleted. Continue?", vbOKCancel + vbQuestion, "Clear Data") = vbCancel) Then
Exit Sub
End If
End If
Sheets("RawData").UsedRange.ClearContents
Sheets("BikeRawData").UsedRange.ClearContents
' Since we are importing new data, see if we should clear any specified zone info
r = Sheets("Setup").Range("SetupZone1").Row
c = Sheets("Setup").Range("SetupZone1").Column
For i = 0 To MaxZones - 1
If (Sheets("Setup").Cells(r + i, c).Value <> "" Or Sheets("Setup").Cells(r + i, c + 1).Value <> "") Then
If (MsgBox("Clear current zone settings?", vbYesNo + vbQuestion, "Clear Zones") = vbNo) Then
Exit For
End If
Sheets("Setup").Unprotect
Sheets("Setup").Range(Cells(r, c), Cells(r + MaxZones - 1, c)).Value = ""
Sheets("Setup").Range(Cells(r, c + 1), Cells(r + MaxZones - 1, c + 3)).Value = ""
Sheets("Setup").Protect
Exit For
End If
Next i
' Check file size and warn if too large
If (FileLen(sFilename) > 10000000) Then
Call MsgBox("Data import may take several minutes--please be patient.", vbOKOnly + vbInformation, "Import Data")
End If
' Set raw data binning interval. Default is 5 minutes.
interval = Sheets("Setup").Range("SetupRawBinInterval")
If (interval < 1 Or interval > 60) Then
interval = 5
End If
-
Nov 3rd, 2020, 03:36 AM
#4
Re: Adapt excel macro to accept dir.
Application.OpenFolder() but it just threw an exception saying it failed
this is the line that opens the dialog
Code:
Fname = Application.GetOpenFilename("Vision Data File (*.csv), *.csv, All files (*.*), *.*", 1, "Import Data")
to change to a folder dialog you probably need to shellbrowseforfolder, which can have several options, including a starting folder and whether to create a new folder
there will be many examples in this forum if you search on shellbrowseforfolder, there are 2 methods to use this APIs or scripting, the scripting method should do all you need
in its most simple try
Code:
Set sh = CreateObject("shell.application")
Set folderbrowser = sh.browseforfolder(0, "Please select the folder.", 1, "")
you should dimension (dim) whatever variables you want to use
you can just use object or variant, but if you want intellisense to help, you will need to add a reference to shell automation and use the correct variable type
i am sure you will need more, so search for other examples to do what you want, post problems here when you've had a go
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|