Excel VBA ENVIRON (Περιβάλλον)
Η συνάρτηση VBA ENVIRON (σημαίνει ΠΕΡΙΒΑΛΛΟΝ ) που μπορεί να χαρακτηριστεί ως συνάρτηση πληροφοριών καθώς αυτή η συνάρτηση επιστρέφει τις τιμές για μεταβλητές περιβάλλοντος λειτουργικού συστήματος. Οι μεταβλητές περιβάλλοντος (Λειτουργικό σύστημα) περιέχουν πληροφορίες σχετικά με τα προφίλ όλων των χρηστών, το όνομα χρήστη, το προφίλ χρήστη, έναν αρχικό φάκελο για τον χρήστη κ.λπ. Αυτή η λειτουργία επιστρέφει μια τιμή συμβολοσειράς.
Σύνταξη
Αυτή η συνάρτηση έχει μόνο ένα όρισμα που είναι « Έκφραση». Μπορούμε να καθορίσουμε την αριθμητική θέση (ακέραια τιμή) που αντιπροσωπεύει την αριθμητική θέση της μεταβλητής περιβάλλοντος στον πίνακα μεταβλητής περιβάλλοντος ή το ίδιο το όνομα της μεταβλητής .
Εάν καθορίσουμε την αριθμητική θέση, τότε η συνάρτηση επιστρέφει τη μεταβλητή περιβάλλοντος και την τιμή της, και οι δύο με ίση είσοδο μεταξύ.
Εάν καθορίσουμε το όνομα της μεταβλητής, τότε η μόνη τιμή επιστρέφεται από τη συνάρτηση.
Παραγωγή:
Πώς να χρησιμοποιήσετε τη λειτουργία Environ στο VBA;
Παράδειγμα # 1
Ανοίξτε τη γραμμή εντολών χρησιμοποιώντας τη συνάρτηση ENVIRON στο VBA .
Για να κάνετε το ίδιο, τα βήματα θα ήταν:
Εισαγάγετε το κουμπί εντολής χρησιμοποιώντας την εντολή «Εισαγωγή» που είναι διαθέσιμη στην ομάδα «Έλεγχοι» στην καρτέλα «Προγραμματιστής» ή χρησιμοποιήστε το πλήκτρο συντόμευσης excel ( Alt + F11 ).
Εάν η καρτέλα «Προγραμματιστής» δεν είναι ορατή, ακολουθήστε τα παρακάτω βήματα για να κάνετε την καρτέλα ορατή.
Κάντε κλικ στο «Αρχείο» και επιλέξτε «Επιλογές» από τη λίστα.
Επιλέξτε «Προσαρμογή κορδέλας» από το αριστερό μενού και επιλέξτε το πλαίσιο για την καρτέλα «Προγραμματιστής» και κάντε κλικ στο «OK».
Τώρα η «καρτέλα προγραμματιστή» είναι ορατή.
Ενώ εισάγετε το κουμπί εντολής, εάν συνεχίζουμε να πατάμε το πλήκτρο ALT , τότε τα άκρα του κουμπιού εντολής θα είναι μαζί με το περίγραμμα του κελιού. Αλλάξτε τις ιδιότητες του κουμπιού εντολής που εισάγετε χρησιμοποιώντας το μενού με βάση τα συμφραζόμενα, το οποίο λαμβάνουμε κάνοντας δεξί κλικ στο "κουμπί εντολής".
Παράθυρο ιδιοτήτων
Για να γράψουμε τον κώδικα VBA για το κουμπί εντολών, πρέπει να επιλέξουμε το κουμπί εντολής και να επιλέξουμε «Προβολή κώδικα» από το μενού με βάση τα συμφραζόμενα.
Γράψτε τον κωδικό ως εξής:
Έχουμε καλέσει τη λειτουργία «Shell» για να πληκτρολογήσετε εντολή για να εκτελέσετε ένα πρόγραμμα (στην περίπτωσή μας, γραμμή εντολών).
Έχουμε χρησιμοποιήσει το «ComSpec», το οποίο σημαίνει «Command Specifier».
Τώρα βγείτε από το VBE και κάντε κλικ στο κουμπί εντολής. Έχουμε εμφανίσει μια γραμμή εντολών.
Παράδειγμα # 2
Ας υποθέσουμε ότι θέλουμε να εξαγάγουμε ονόματα αρχείων και λεπτομέρειες για τον επιλεγμένο φάκελο ως εξής.
Τα βήματα για να κάνετε το ίδιο είναι:
Γεμίστε τα κελιά B2: H9 με ανοιχτό πορτοκαλί χρώμα.
Δημιουργήστε την ετικέτα χρησιμοποιώντας την εντολή «Εισαγωγή» στην ομάδα «Έλεγχοι» στο «Προγραμματιστής».
Δημιουργήστε κάτω εμφανίζονται ετικέτες και να επεξεργαστείτε τις ιδιότητες όπως η λεζάντα , Χρώμα φόντου , BackStyle , BorderStyle , Σκιά.
Δημιουργήστε το Combo Box ως εξής χρησιμοποιώντας την εντολή Combo Box (ένα από τα στοιχεία ελέγχου ActiveX) που είναι διαθέσιμη στην εντολή Insert στην ομάδα Controls στο Developer.
Αφού δημιουργήσουμε το Combo Box στο excel ως εξής, μπορούμε να αλλάξουμε τις ιδιότητες.
We will add code for the list to be displayed in the combo box using the View Code command in the contextual menu.
It is a code for “Select the Folder” ComboBox.
It is a code for “SortBy” ComboBox.
It is a code for “Select the Order” ComboBox.
We will create a list box containing all file types to select them to get only that types of files in the result. To do the same, please choose “List Box (ActiveX Control)” from the “Insert” command in the “Controls” group in the “Developer” tab.
Drag the list box, as shown below.
Change the properties of the list box as follows.
To add the file types to the list box, please use the following code.
Write the code in “This workbook.”
Code:
Private Sub Workbook_Open() Dim ArrFileType(25) As Variant ArrFileType(0) = "Microsoft Excel 97-2003 Worksheet(.xls)" ArrFileType(1) = "Microsoft Office Excel Worksheet(.xlsx)" ArrFileType(2) = "Microsoft Excel Macro-Enabled Worksheet(.xlsm)" ArrFileType(3) = "Word Document 97-2003(.doc)" ArrFileType(4) = "Word Document 2007-2010(.docx)" ArrFileType(5) = "Text Document(.txt)" ArrFileType(6) = "Adobe Acrobat Document(.pdf)" ArrFileType(7) = "Compressed (zipped) Folder(.Zip)" ArrFileType(8) = "WinRAR archive(.rar)" ArrFileType(9) = "Configuration settings(.ini)" ArrFileType(10) = "GIF File(.gif)" ArrFileType(11) = "PNG File(.png.webp)" ArrFileType(12) = "JPG.webp File(.jpg.webp)" ArrFileType(13) = "MP3 Format Sound(.mp3)" ArrFileType(14) = "M3U File(.m3u)" ArrFileType(15) = "Rich Text Format(.rtf)" ArrFileType(16) = "MP4 Video(.mp4)" ArrFileType(17) = "Video Clip(.avi)" ArrFileType(18) = "Windows Media Player(.mkv)" ArrFileType(19) = "SRT File(.srt)" ArrFileType(20) = "PHP File(.php)" ArrFileType(21) = "Firefox HTML Document(.htm, .html)" ArrFileType(22) = "Cascading Style Sheet Document(.css)" ArrFileType(23) = "JScript Script File(.js)" ArrFileType(24) = "XML Document(.xml)" ArrFileType(25) = "Windows Batch File(.bat)" Sheet2.FileTypesListBox.List = ArrFileType End Sub
Insert the checkboxes using the same “Insert” command in the “Controls” group in the “Developer” tab and change the properties for inserted ‘Checkboxes’ using the ‘Properties’ power available in the same group after selecting the objects.
Insert command buttons using the ‘Insert’ command available in the same group and change the properties like a caption and other stuff.
We have formed the entire structure. Now we need to write the code.
Activate the ‘Design Mode,’ and right-click on the “Fetch all files details” button to choose the “View Code” from the contextual menu to add the code for the switch.
We will declare some variables first in the module.
Below is the code added to a “Fetch all files details” button.
Code:
Private Sub FetchFilesBtnCommandButton_Click() iRow = 14 fPath = Environ("HOMEPATH") & " " & SelectTheFolderComboBox.Value If fPath "" Then Set FSO = New Scripting.FileSystemObject If FSO.FolderExists(fPath) False Then Set SourceFolder = FSO.GetFolder(fPath) If Sheet2.IncludingSubFoldersCheckBox.Value = True Then IsSubFolder = True Else IsSubFolder = False If SourceFolder.Files.Count = 0 Then MsgBox "No files exists in this Folder" & vbNewLine & vbNewLine & "Check your folder path and Try Again !!", vbInformation Exit Sub End If End If Call ClearResult If FetchAllTypesOfFilesCheckBox.Value = True Then Call ListFilesInFolder(SourceFolder, IsSubFolder) Call ResultSorting(xlAscending, "C14", "D14", "E14") Else Call ListFilesInFolderXtn(SourceFolder, IsSubFolder) Call ResultSorting(xlAscending, "C14", "D14", "E14") End If FilesCountLabel.Caption = iRow - 14 Else MsgBox "Selected Path Does Not Exist !!" & vbNewLine & vbNewLine & "Select Correct One and Try Again !!", vbInformation End If Else MsgBox "Folder Path Can not be Empty !!" & vbNewLine & vbNewLine & "", vbInformation End If End Sub
Define the ‘ClearResult’ function in the module. To insert the module, select ‘ThisWorkbook’ then ‘Insert’ and then ‘Module”’.
Write the following code in the module.
Code for ClearResult
There are more subroutines like ‘ListFilesInFolder,’ ‘ListFilesInFolderXtn,’ ‘ResultSorting,’ we will define all these subroutines in the module.
‘ListFilesInFolder’
Code:
Public Sub ListFilesInFolder(SourceFolder As Scripting.Folder, IncludeSubfolders As Boolean) On Error Resume Next For Each FileItem In SourceFolder.Files ' display file properties Cells(iRow, 2).Formula = iRow - 13 Cells(iRow, 3).Formula = FileItem.Name Cells(iRow, 4).Formula = FileItem.Path Cells(iRow, 5).Formula = Int(FileItem.Size / 1024) Cells(iRow, 6).Formula = FileItem.Type Cells(iRow, 7).Formula = FileItem.DateLastModified Cells(iRow, 8).Select Selection.Hyperlinks.Add Anchor:=Selection, Address:= _ FileItem.Path, TextToDisplay:="Click Here to Open" 'Cells(iRow, 8).Formula = "=HYPERLINK(""" & FileItem.Path & """,""" & "Click Here to Open" & """)" iRow = iRow + 1 ' next row number Next FileItem If IncludeSubfolders Then For Each SubFolder In SourceFolder.SubFolders ListFilesInFolder SubFolder, True Next SubFolder End If Set FileItem = Nothing Set SourceFolder = Nothing Set FSO = Nothing End Sub
‘ListFilesInFolderXtn’
Public Sub ListFilesInFolderXtn(SourceFolder As Scripting.Folder, IncludeSubfolders As Boolean) On Error Resume Next Dim FileArray As Variant FileArray = Get_File_Type_Array For Each FileItem In SourceFolder.Files Call ReturnFileType(FileItem.Type, FileArray) If IsFileTypeExists = True Then Cells(iRow, 2).Formula = iRow - 13 Cells(iRow, 3).Formula = FileItem.Name Cells(iRow, 4).Formula = FileItem.Path Cells(iRow, 5).Formula = Int(FileItem.Size / 1024) Cells(iRow, 6).Formula = FileItem.Type Cells(iRow, 7).Formula = FileItem.DateLastModified Cells(iRow, 8).Select Selection.Hyperlinks.Add Anchor:=Selection, Address:= _ FileItem.Path, TextToDisplay:="Click Here to Open" 'Cells(iRow, 8).Formula = "=HYPERLINK(""" & FileItem.Path & """,""" & "Click Here to Open" & """)" iRow = iRow + 1 ' next row number End If Next FileItem If IncludeSubfolders Then For Each SubFolder In SourceFolder.SubFolders ListFilesInFolderXtn SubFolder, True Next SubFolder End If Set FileItem = Nothing Set SourceFolder = Nothing Set FSO = Nothing End Sub
‘ResultSorting’
Sub ResultSorting(xlSortOrder As String, sKey1 As String, sKey2 As String, sKey3 As String) Range("C13").Select Range(Selection, Selection.End(xlDown)).Select Range(Selection, Selection.End(xlToRight)).Select Selection.Sort Key1:=Range(sKey1), Order1:=xlSortOrder, Key2:=Range(sKey2 _ ), Order2:=xlAscending, Key3:=Range(sKey3), Order3:=xlSortOrder, Header _ :=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom _ , DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _ xlSortNormal Range("B14").Select End Sub
In ‘ListFilesInFolderXtn’ subroutine, we have called a function named ‘ReturnFileType’ and ‘GetFileTypeArray’, we need to define the functions in the same module.
‘ReturnFileType’
Code:
Public Function ReturnFileType(fileType As String, FileArray As Variant) As Boolean Dim i As Integer IsFileTypeExists = False For i = 1 To UBound(FileArray) + 1 If FileArray(i - 1) = fileType Then IsFileTypeExists = True Exit For Else IsFileTypeExists = False End If Next End Function
‘GetFileTypeArray’
Code:
Public Function Get_File_Type_Array() As Variant Dim i, j, TotalSelected As Integer Dim arrList() As String TotalSelected = 0 For i = 0 To Sheet2.FileTypesListBox.ListCount - 1 If Sheet2.FileTypesListBox.Selected(i) = True Then TotalSelected = TotalSelected + 1 End If Next ReDim arrList(0 To TotalSelected - 1) As String j = 0 i = 0 For i = 0 To Sheet2.FileTypesListBox.ListCount - 1 If Sheet2.FileTypesListBox.Selected(i) = True Then arrList(j) = Left(Sheet2.FileTypesListBox.List(i), InStr(1, Sheet2.FileTypesListBox.List(i), "(") - 1) j = j + 1 End If Next Get_File_Type_Array = arrList End Function
We have a command button captioned as ‘Export to Excel File,’ we need to write the code for this button as follows:
In Module, define the subroutine named ‘Export_to_excel.’
Code:
Sub Export_to_excel() On Error GoTo err Dim xlApp As New Excel.Application Dim xlWB As New Workbook Set xlWB = xlApp.Workbooks.Add 'xlWB.Add xlApp.Visible = False ThisWorkbook.Activate Range("B13").Select Range(Selection, Selection.End(xlDown)).Select Range(Selection, Selection.End(xlToRight)).Select Selection.Copy xlApp.Visible = True xlWB.Activate xlWB.Sheets("Sheet1").Select xlWB.Sheets("Sheet1").Range("B2").PasteSpecial Paste:=xlPasteValues xlWB.Sheets("Sheet1").Cells.Select xlWB.Sheets("Sheet1").Cells.EntireColumn.AutoFit xlWB.Sheets("Sheet1").Range("B2").Select Exit Sub err: MsgBox ("Error Occured while exporting. Try again") End Sub
We have one more command button captioned as ‘Export to Text File.’ We will write the code for the command button as follows:
In this code, we can see that we have a user form, which we need to design using the following steps:
Right Click on the ‘Sheet2 (Example2)’ sheet and choose ‘Insert’ and then ‘UserForm’ from the menu.
Design the UserForm using tools from the toolbox.
We have used ‘Labels,’ ‘Combo Box,’ ‘Text Box,’ and ‘Command buttons’ for the Userform and have changed caption and name for all the components.
For the first command button (OK), we have to write the code as follows:
Code:
Private Sub CommandButton1_Click() Dim iSeperator As String If ComboBox1.Value = "Other" Then iSeperator = TextBox1.Value Else iSeperator = ComboBox1.Value End If If iSeperator = "" Then If MsgBox("Hello You have not selected any delimeter." & vbNewLine & vbNewLine & _ " It will be very difficult to read the Text file, without specific delimiter", vbYesNo) = vbYes Then Call textfile(iSeperator) Else Exit Sub End If Else Select Case ComboBox1.ListIndex Case 0: iSeperator = "," Case 1: iSeperator = "|" Case 2: iSeperator = "vbTab" Case 3: iSeperator = ";" End Select Call textfile(iSeperator) Unload Me End If End Sub
We have called the ‘textfile’ function in the subroutine for the command button, so we need to define the ‘textfile’ function in the module.
Code:
Sub textfile(iSeperator As String) Dim iRow, iCol Dim iLine, f ThisWorkbook.Activate Range("B13").Select TotalRowNumber = Range(Selection, Selection.End(xlDown)).Count - 12 If iSeperator "vbTab" Then Open ThisWorkbook.Path & "File1.txt" For Output As #1 Print #1, "" Close #1 Open ThisWorkbook.Path & "File1.txt" For Append As #1 For iRow = 13 To TotalRowNumber iLine = "" For iCol = 2 To 7 iLine = iLine & iSeperator & Cells(iRow, iCol).Value Next Print #1, iLine Next Close #1 Else Open ThisWorkbook.Path & "File1.txt" For Output As #1 Print #1, "" Close #1 Open ThisWorkbook.Path & "File1.txt" For Append As #1 For iRow = 13 To TotalRowNumber iLine = "" For iCol = 2 To 7 iLine = iLine & vbTab & Cells(iRow, iCol).Value Next Print #1, iLine Next Close #1 End If f = Shell("C:WINDOWSotepad.exe " & ThisWorkbook.Path & "File1.txt", vbMaximizedFocus) MsgBox "Your File is saved in " & ThisWorkbook.Path & "File1.txt" End Sub
For command button 2 (Cancel), we need to write the following code. Double click on the cancel button to write the code.
For the Combo Box for selecting a specifier, write the following code.
For the UserForm, write the following code.
For the ‘Fetch all type of files’ checkbox, write the following code.
For the ‘ListBox’ for file types, write the following code.
For the ‘SelectTheOrder’ combo box, write the following code.
Code:
Private Sub SelectTheOrderComboBox_Change() Select Case (SelectTheOrderComboBox.Value) Case "Ascending" If SortByComboBox.Value = "File Name" Then Call ResultSorting(xlAscending, "C14", "E14", "G14") End If If SortByComboBox.Value = "File Type" Then Call ResultSorting(xlAscending, "F14", "E14", "C14") End If If SortByComboBox.Value = "File Size" Then Call ResultSorting(xlAscending, "E14", "C14", "G14") End If If SortByComboBox.Value = "Last Modified" Then Call ResultSorting(xlAscending, "G14", "C14", "E14") End If Case "Descending" If SortByComboBox.Value = "File Name" Then Call ResultSorting(xlDescending, "C14", "E14", "G14") End If If SortByComboBox.Value = "File Type" Then Call ResultSorting(xlDescending, "F14", "E14", "C14") End If If SortByComboBox.Value = "File Size" Then Call ResultSorting(xlDescending, "E14", "C14", "G14") End If If SortByComboBox.Value = "Last Modified" Then Call ResultSorting(xlDescending, "G14", "C14", "E14") End If Case Default Exit Sub End Select End Sub
For the ‘Sort by’ combo box, we will write the following code.
Code:
Private Sub SortByComboBox_Change() Select Case (SelectTheOrderComboBox.Value) Case "Ascending" If SortByComboBox.Value = "File Name" Then Call ResultSorting(xlAscending, "C14", "E14", "G14") End If If SortByComboBox.Value = "File Type" Then Call ResultSorting(xlAscending, "F14", "E14", "C14") End If If SortByComboBox.Value = "File Size" Then Call ResultSorting(xlAscending, "E14", "C14", "G14") End If If SortByComboBox.Value = "Last Modified" Then Call ResultSorting(xlAscending, "G14", "C14", "E14") End If Case "Descending" If SortByComboBox.Value = "File Name" Then Call ResultSorting(xlDescending, "C14", "E14", "G14") End If If SortByComboBox.Value = "File Type" Then Call ResultSorting(xlDescending, "F14", "E14", "C14") End If If SortByComboBox.Value = "File Size" Then Call ResultSorting(xlDescending, "E14", "C14", "G14") End If If SortByComboBox.Value = "Last Modified" Then Call ResultSorting(xlDescending, "G14", "C14", "E14") End If Case Default Exit Sub End Select End Sub
Τώρα έχουμε γράψει ολόκληρο τον κώδικα. Τώρα μπορούμε να επιλέξουμε τον επιθυμητό φάκελο και τύπο αρχείου και να μάθουμε τη λίστα για τα αρχεία, τα οποία μπορούμε να ταξινομήσουμε κατά «Όνομα αρχείου», «Τύπος αρχείου», «Μέγεθος αρχείου» ή «Τελευταία τροποποίηση» και να εξαγάγουμε τη λίστα σε excel ή αρχείο κειμένου.
Πράγματα που πρέπει να θυμάστε
Εάν η τιμή που καθορίζουμε για το όρισμα «επένδυση» δεν βρίσκεται στον πίνακα συμβολοσειράς περιβάλλοντος, η συνάρτηση ENVIRON επιστρέφει τη συμβολοσειρά μηδενικού μήκους.
