Extracting data from cells when non-excel file opened in excel

[mrina970]

I have a macro that works for extracting specific cells of data from .xlsx files.

Unfortunately, I first have to open each of the .dpt files in excel and re-save them as .xlsx files. Since the .dpt files can open in excel, is there a way to skip the middle step of saving each file as .xlsx and just go right from the .dpt file to taking the data?

Here is the macro.


Sub ExtractData()

Dim row As Long
Dim directory, fileName, initialFolder

' Startup folder to begin searching from
initialFolder = "C:\Exported Data\"

' Can set up headers here as desired to auto populate when run on an empty master file
Range("A1").Select
ActiveCell = "File Name"

Range("B1").Select
ActiveCell = "1700"

Range("C1").Select
ActiveCell = "1648"

Range("D1").Select
ActiveCell = "1583"

Range("E1").Select
ActiveCell = "1550"


' Uncomment this block below with the closing End If + End With to enable choosing a folder
' With Application.FileDialog(msoFileDialogFolderPicker)
'.InitialFileName = Application.DefaultFilePath & "\"
'.Title = "Please select a folder to list Files from"
'.InitialFileName = initialFolder
'.Show
'If .SelectedItems.Count <> 0 Then
'directory = .SelectedItems(1) & "\"

' start injecting data on row 2
row = 2

' Get file list
fileName = Dir(initialFolder)
' For all files found
Do While fileName <> ""

' Check the extension, only process xlsx files
' Also, do not process temporary files designated by prepended ~
fileExtension = Right(fileName, 5)
If StrComp(fileExtension, ".xlsx") = 0 And Left(fileName, 1) <> "~" Then

' used below
targetFileFullPath = initialFolder + fileName

' construct cell to store to
' file names go in colum A
fileNameCell = "A" + Trim(Str(row))
' select row in colum A
Range(fileNameCell).Select
' store the value
ActiveCell = fileName

copyToCell = "B" + Trim(Str(row))
Call CopyFromSheetToCellsInActive(targetFileFullPath, "B1192", copyToCell)

copyToCell = "C" + Trim(Str(row))
Call CopyFromSheetToCellsInActive(targetFileFullPath, "B1219", copyToCell)

copyToCell = "D" + Trim(Str(row))
Call CopyFromSheetToCellsInActive(targetFileFullPath, "B1253", copyToCell)

copyToCell = "E" + Trim(Str(row))
Call CopyFromSheetToCellsInActive(targetFileFullPath, "B1270", copyToCell)

' next row
row = row + 1
End If

' go to next file
fileName = Dir
Loop
'End If
'End With
End Sub


Sub CopyFromSheetToCellsInActive(copyFromSheet, copyFromCell, copyToCell)

' open excel spreadsheet with data to extract
Workbooks.Open (copyFromSheet)
' copy desired value
Range(copyFromCell).Copy
' close excel spreadsheet that had the desired data
ActiveWorkbook.Close

' switch back to the active workbook
ThisWorkbook.Activate
' paste into main workbook
Range(copyToCell).Select
ActiveSheet.Paste


End Sub