Dark91zc
Board Regular
- Joined
- Aug 1, 2013
- Messages
- 62
Hello All,
And thank you for looking and helping. This is what i am doing. My current code allows me to import folder names into the excel spreadsheet. When the data is imported it is broken down into 4 columns. They are the following Last Name, First Name, MDR, and D.O.B. Everything is correct except the sorting of the MDR. It is a Terminal Digit Filing system used by the customer. So here is an example. You have an 8 digit code or number, 00234589 this would be the patients MDR. The correct way to "read" it is as follows, last 2 digits first, 89, middle 2 digits second, 45, then the first 4 digits, 0023. Now here is the trick, it stays the same visually as it is imported but sorted this way 89,45,0023.
Is there a way that this can be in a macro or script? If so can this be done during the import of the folder directory to excel, or will it have to be a stand alone run after macro / script?
This is what my sheet looks like
<tbody>
</tbody>
What I would like it to look like is this.
<tbody>
</tbody>
I am hoping that if and when this is sorted the other columns A,B, and D follow C still.
The following is the code / script i would like the code to be put into so it can run with the main macro.
Once again thank you.
And thank you for looking and helping. This is what i am doing. My current code allows me to import folder names into the excel spreadsheet. When the data is imported it is broken down into 4 columns. They are the following Last Name, First Name, MDR, and D.O.B. Everything is correct except the sorting of the MDR. It is a Terminal Digit Filing system used by the customer. So here is an example. You have an 8 digit code or number, 00234589 this would be the patients MDR. The correct way to "read" it is as follows, last 2 digits first, 89, middle 2 digits second, 45, then the first 4 digits, 0023. Now here is the trick, it stays the same visually as it is imported but sorted this way 89,45,0023.
Is there a way that this can be in a macro or script? If so can this be done during the import of the folder directory to excel, or will it have to be a stand alone run after macro / script?
This is what my sheet looks like
| Last Name: | First Name: | MDR: | D.O.B.: |
| row | 1 | 00778742 | |
| row | 2 | 01094917 | |
| row | 3 | 00244412 | |
| row | 4 | 00836117 | |
| row | 5 | 00909208 | |
| row | 6 | 00939129 | |
| row | 7 | 00898637 | |
| row | 8 | 00914241 | |
| row | 9 | 00953518 |
<tbody>
</tbody>
What I would like it to look like is this.
| Last Name: | First Name: | MDR: | D.O.B.: |
| new row1 | old row5 | 00909208 | |
| new row2 | old row3 | 00244412 | |
| new row3 | old row2 | 01094917 | |
| new row4 | old row4 | 00836117 | |
| new row5 | old row9 | 00953518 | |
| new row6 | old row6 | 00939129 | |
| new row7 | old row7 | 00898637 | |
| new row8 | old row8 | 00914241 | |
| new row9 | old row1 | 00778742 |
<tbody>
</tbody>
I am hoping that if and when this is sorted the other columns A,B, and D follow C still.
The following is the code / script i would like the code to be put into so it can run with the main macro.
Code:
Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Sub ImportFilesInFolder()
'Workbooks.Add ' create a new workbook for the file list
' add headers
'With Range("A1")
' .Formula = "Folder contents:"
' .Font.Bold = False
' .Font.Size = 12
'End With
Range("A1").Formula = "Last Name:"
Range("B1").Formula = "First Name:"
Range("C1").Formula = "MDR:"
Range("D1").Formula = "D.O.B.:"
' Range("E1").Formula = "Date Last Accessed:"
' Range("F1").Formula = "Date Last Modified:"
' Range("G1").Formula = "Attributes:"
' Range("H1").Formula = "Short File Name:"
Range("A1:H1").Font.Bold = True
Msg = "Select a location containing the folders you want to list."
'Directory = GetDirectory(Msg)
'list all files included subfolders
ListFilesInFolder GetDirectory(Msg), True
End Sub
Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)
' lists information about the files in SourceFolder
' example: ListFilesInFolder "C:\FolderName\", True
Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim r As Long
Dim Elements As Variant
Dim Temp As String
Set FSO = New Scripting.FileSystemObject
Set SourceFolder = FSO.GetFolder(SourceFolderName)
r = Range("A65536").End(xlUp).Row + 1
For Each SubFolder In SourceFolder.SubFolders
' display file properties
'Temp = StrReverse(SubFolder.Name)
'Temp = Right(Temp, Len(Temp) - InStr(Temp, "."))
'Temp = StrReverse(Temp)
If InStr(SubFolder.Name, "_") Then
Elements = Split(Replace(SubFolder.Name, "^", "_"), "_")
If UBound(Elements) = 3 Then
Cells(r, 1) = Elements(0)
Cells(r, 2) = Elements(1)
Cells(r, 3) = Elements(2)
Cells(r, 4) = Elements(3)
' Cells(r, 2).Formula = FileItem.Size
' Cells(r, 3).Formula = FileItem.Type
' Cells(r, 4).Formula = FileItem.DateCreated
' Cells(r, 5).Formula = FileItem.DateLastAccessed
' Cells(r, 6).Formula = FileItem.DateLastModified
' Cells(r, 7).Formula = FileItem.Attributes
' Cells(r, 8).Formula = FileItem.ShortPath & FileItem.ShortName
r = r + 1 ' next row number
End If
End If
Next SubFolder
If IncludeSubfolders Then
For Each SubFolder In SourceFolder.SubFolders
ListFilesInFolder SubFolder.path, True
Next SubFolder
End If
Columns("A:D").AutoFit
Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing
ActiveWorkbook.Saved = True
End Sub
Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
bInfo.pidlRoot = 0&
If IsMissing(Msg) Then
bInfo.lpszTitle = "Select a folder."
Else
bInfo.lpszTitle = Msg
End If
bInfo.ulFlags = &H1
x = SHBrowseForFolder(bInfo)
If x = 0 Then End
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Else
GetDirectory = ""
End If
End FunctionOnce again thank you.
