Hi,
I have a very straight forward spreadsheet, which performs a currency conversion on the first sheet, with user defined currency codes and value. The Exchange rates are obtained through a macro button, which opens a text file, chosen by the user, named ***EXR.txt as a temporary workbook, copys the data and pastes it into a newly created sheet in the original workbook, before closing the temporary workbook. It then names a range for the data and uses that as a reference for a vlookup on the 1st sheet.
This is all working fine. However, I also wanted to display the creation date of the import file being used, so that the user knows which days exchange rates are being used. There is no reference to the date in the filename, and I have no control over changing this. So I was looking to obtain it from the file properties of the import file.
I first looked at using the GetProperty function to obtain the data, but this won't work, as im not actualy opening the original text file, I'm importing the data into a temporary, unsaved workbook, which won't have the original file properties.
CPearson says there is a way to read from closed files, but that I would need to download a Microsoft supplied DLL, called "DSO OLE Document Properties Reader 2.1"
That's all very well and good, but is unrealistic for me to have all the users installing the DLL just for the purposes of this spreadsheet.
Does anybody have any other suggestions? Can I open the text file temporarily outside of Excel and get the properties that way?
Current Code, where 'FilesToOpen' is the user selected text file:
Sub LoadXRATES()
' LoadXRATES Macro
' Written By Frank Vernor - D245911
' 22nd Sept 2009
Dim FilesToOpen
Dim wkbk As Workbook
Dim wkbTemp As Workbook
Dim sDelimiter As String
Dim LRW As Integer
Dim sh As Worksheet, flg As Boolean
Application.DisplayAlerts = False
For Each sh In Worksheets
If sh.Name = "Rates" Then flg = True: Exit For
Next
If flg = True Then
Sheets("Rates").Delete
End If
Application.DisplayAlerts = True
On Error GoTo ErrHandler
Application.ScreenUpdating = False
Set wkbk = ActiveWorkbook
sDelimiter = ","
FilesToOpen = Application.GetOpenFilename _
(FileFilter:="Text Files (*.txt), *.txt", _
MultiSelect:=False, Title:="Text Files to Open")
If TypeName(FilesToOpen) = "Boolean" Then
MsgBox "No Files were selected"
GoTo ExitHandler
End If
Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen)
wkbTemp.Activate
RateName = Right((Sheets(1).Name), 3)
If RateName <> "EXR" Then
MsgBox "Invalid File Type - Must end EXR.txt"
wkbTemp.Close (False)
GoTo ExitHandler
End If
Columns("A:A").Select
Selection.Copy
wkbk.Sheets.Add.Name = "Rates"
wkbk.Activate
Sheets("Rates").Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1)), TrailingMinusNumbers:=True
wkbTemp.Close (False)
Columns("A:J").EntireColumn.AutoFit
Cells.Replace What:="+", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Sheets("Rates").Move After:=Sheets("X-Rates Converter")
LRW = Range("a65536").End(xlUp).Row
ActiveWorkbook.Names.Add Name:="Rate_Data", RefersToR1C1:="='Rates'!R1C1:R" & LRW & "C7"
Sheets("X-Rates Converter").Activate
MsgBox "Rates Have been Loaded"
ExitHandler:
Application.ScreenUpdating = True
Set wkbk = Nothing
Set wkbTemp = Nothing
Exit Sub
ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub
Apologies for my poor VB Prose, I'm a butcher when it comes to VBA, I have bought the Mr Excel 2007 book though - just need time to work through it!!
Users using XP and Excel 2002 Sp3 or 2003
I have a very straight forward spreadsheet, which performs a currency conversion on the first sheet, with user defined currency codes and value. The Exchange rates are obtained through a macro button, which opens a text file, chosen by the user, named ***EXR.txt as a temporary workbook, copys the data and pastes it into a newly created sheet in the original workbook, before closing the temporary workbook. It then names a range for the data and uses that as a reference for a vlookup on the 1st sheet.
This is all working fine. However, I also wanted to display the creation date of the import file being used, so that the user knows which days exchange rates are being used. There is no reference to the date in the filename, and I have no control over changing this. So I was looking to obtain it from the file properties of the import file.
I first looked at using the GetProperty function to obtain the data, but this won't work, as im not actualy opening the original text file, I'm importing the data into a temporary, unsaved workbook, which won't have the original file properties.
CPearson says there is a way to read from closed files, but that I would need to download a Microsoft supplied DLL, called "DSO OLE Document Properties Reader 2.1"
That's all very well and good, but is unrealistic for me to have all the users installing the DLL just for the purposes of this spreadsheet.
Does anybody have any other suggestions? Can I open the text file temporarily outside of Excel and get the properties that way?
Current Code, where 'FilesToOpen' is the user selected text file:
Sub LoadXRATES()
' LoadXRATES Macro
' Written By Frank Vernor - D245911
' 22nd Sept 2009
Dim FilesToOpen
Dim wkbk As Workbook
Dim wkbTemp As Workbook
Dim sDelimiter As String
Dim LRW As Integer
Dim sh As Worksheet, flg As Boolean
Application.DisplayAlerts = False
For Each sh In Worksheets
If sh.Name = "Rates" Then flg = True: Exit For
Next
If flg = True Then
Sheets("Rates").Delete
End If
Application.DisplayAlerts = True
On Error GoTo ErrHandler
Application.ScreenUpdating = False
Set wkbk = ActiveWorkbook
sDelimiter = ","
FilesToOpen = Application.GetOpenFilename _
(FileFilter:="Text Files (*.txt), *.txt", _
MultiSelect:=False, Title:="Text Files to Open")
If TypeName(FilesToOpen) = "Boolean" Then
MsgBox "No Files were selected"
GoTo ExitHandler
End If
Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen)
wkbTemp.Activate
RateName = Right((Sheets(1).Name), 3)
If RateName <> "EXR" Then
MsgBox "Invalid File Type - Must end EXR.txt"
wkbTemp.Close (False)
GoTo ExitHandler
End If
Columns("A:A").Select
Selection.Copy
wkbk.Sheets.Add.Name = "Rates"
wkbk.Activate
Sheets("Rates").Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1)), TrailingMinusNumbers:=True
wkbTemp.Close (False)
Columns("A:J").EntireColumn.AutoFit
Cells.Replace What:="+", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Sheets("Rates").Move After:=Sheets("X-Rates Converter")
LRW = Range("a65536").End(xlUp).Row
ActiveWorkbook.Names.Add Name:="Rate_Data", RefersToR1C1:="='Rates'!R1C1:R" & LRW & "C7"
Sheets("X-Rates Converter").Activate
MsgBox "Rates Have been Loaded"
ExitHandler:
Application.ScreenUpdating = True
Set wkbk = Nothing
Set wkbTemp = Nothing
Exit Sub
ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub
Apologies for my poor VB Prose, I'm a butcher when it comes to VBA, I have bought the Mr Excel 2007 book though - just need time to work through it!!
Users using XP and Excel 2002 Sp3 or 2003
