VBA File Directory Issue

Ben85

New Member
Joined
Jan 9, 2017
Messages
30
I need some help I am not sure why how to get this code to run I have tried a few different things, but I just want to be able to easily change the file directory via DIM

Directory = "C:\DATA"
FileName = "PRNT" & i & ".DAT"
DirFile = Directory & FileName

ActiveWorkbook.Queries.Add Name:="PRNT" & i, Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Table.FromColumns({Lines.FromBinary(File.Contents(""C:\DATA\PRNT" & i & ".DAT""), null, null, 1252)})," & Chr(13) & "" & Chr(10) & " #""Removed Alternate Rows"" = Table.AlternateRows(Source,1,1,1)," & Chr(13) & "" & Chr(10) & " #""Transposed Table"" = Table.Transpose(#""Removed Alternate Rows"")" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Transposed Table"""

i tried to do File.Contents(" & DirFile & ")
but that doesn't work... I tried it a couple different ways but I just can get it to work... The code looks good in the Locals window, but I must be screwing up something when i try to put in the variable.

I appreciate any help. I can post ALL the code if desired, but there is a loop etc. It all works until i try to change the directory File.Contents directory code...

Here is my full code just in case... But there is plenty of extra non related code in it.
Code:
Sub ImportFilesData()
    ' Macro1 Macro
    Dim i As Variant, DQuery As Object, DConn As Object, objList As ListObject, DirFile As String, LoopEnd As Integer
    Dim Directory As String, FileName As String
    
    Directory = "C:\DATA\"
        If Len(Dir(Directory)) = 0 Then
            MsgBox ("File directory is not valid.")
            Exit Sub
        End If
    
    ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)).Name = "Data_" & Format(Date, "YYMMDD_") & ThisWorkbook.Sheets.Count
    
    'Set this to the largest number on filename
    LoopEnd = 1000
    
    'Range("$A$1").Value = Date
    Application.ScreenUpdating = False


    For i = 0 To LoopEnd
        i = Format(i, "0000")
        Range("A9999").Select
        Selection.End(xlUp).Select
        ActiveCell.Offset(1, 0).Select
        
        FileName = "PRNT" & i & ".DAT"
        DirFile = Directory & FileName
            
        On Error Resume Next
            If Len(Dir(DirFile)) = 0 Then
            Else
            Application.CutCopyMode = False
            ActiveWorkbook.Queries.Add Name:="PRNT" & i, Formula:= _
                "let" & Chr(13) & "" & Chr(10) & "    Source = Table.FromColumns({Lines.FromBinary(File.Contents(""C:\DATA\PRNT" & i & ".DAT""), null, null, 1252)})," & Chr(13) & "" & Chr(10) & "    #""Removed Alternate Rows"" = Table.AlternateRows(Source,1,1,1)," & Chr(13) & "" & Chr(10) & "    #""Transposed Table"" = Table.Transpose(#""Removed Alternate Rows"")" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Transposed Table"""
                With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
                    "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=PRNT" & i & ";Extended Properties=""""" _
                    , Destination:=ActiveCell).QueryTable
                    .CommandType = xlCmdSql
                    .CommandText = Array("SELECT * FROM [PRNT" & i & "]")
                    .RowNumbers = False
                    .FillAdjacentFormulas = False
                    .PreserveFormatting = True
                    .RefreshOnFileOpen = False
                    .BackgroundQuery = True
                    .RefreshStyle = xlInsertDeleteCells
                    .SavePassword = False
                    .SaveData = True
                    .AdjustColumnWidth = True
                    .RefreshPeriod = 0
                    .PreserveColumnInfo = True
                    .ListObject.DisplayName = "PRNT" & i
                    .Refresh BackgroundQuery:=False
                End With
            End If
            Next i
    
    For Each DQuery In ThisWorkbook.Queries
        DQuery.Delete
    Next


    For Each DConn In ThisWorkbook.Connections
        DConn.Delete
    Next


    For Each objList In ActiveWorkbook.ActiveSheet.ListObjects
        objList.Unlist
    Next objList
    
    For i = 0 To LoopEnd
        If ActiveCell.Row <= 5 Then
        Rows(1).Select
        Selection.Delete Shift:=xlUp
            Exit Sub
        Else
            ActiveCell.Offset(-2, 0).Select
            Rows(ActiveCell.Row).Select
            Selection.Delete Shift:=xlUp
        End If
    Next i
    
    Application.ScreenUpdating = True
End Sub
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
Working code:
Code:
File.Contents("[B]"C:\[/B][B]DATA[COLOR=#ff0000]\[/COLOR]PRNT[/B][B]" ..[/B]

Latest code:
Code:
Directory = "C:\DATA"                 where is the path separator?
FileName = "PRNT" & i & ".DAT"
DirFile = Directory & FileName         (or could insert between Directory and FileName)

Try
Code:
Directory = "C:\DATA[B][COLOR=#ff0000]\[/COLOR][/B]"

Learn to use Debug.Print to test your strings
below this line:
Code:
 DirFile = Directory & FileName
insert:
Code:
Debug.Print DirFile
and see result in VBA Immediate Window with {CTRL} G
(delete after testing)
 
Last edited:
Upvote 0
That is mostly my bad the code that is in the window is correct. I changed the directory when i posted the first part of code that doesn't contain the "". My actual code does have the backslash in it as I know that will screw things up quite quickly.
I can get the directory to work the main issue is that when I try to put the directory into the part of the macro with the following.

Code:
[COLOR=#333333]ActiveWorkbook.Queries.Add Name:="PRNT" & i, Formula:= _
[/COLOR][COLOR=#333333]                "let" & Chr(13) & "" & Chr(10) & "    Source = Table.FromColumns({Lines.FromBinary(File.Contents(""C:\DATA\PRNT" & i & ".DAT"")[/COLOR]

That is where it gets hung up...
 
Upvote 0

Forum statistics

Threads
1,214,653
Messages
6,120,751
Members
448,989
Latest member
mariah3

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top