Run-time error '1004': The PivotTable field name is not valid....
Option Explicit
Sub ImportInventoryData() Dim FS As FileSearch Dim FilePath, jane As String, FileSpec As String Dim i As Integer ' Select directory: With Application.FileDialog(msoFileDialogFolderPicker) .InitialFileName = ThisWorkbook.Path & "\" .Title = "Select the Directory for Inventory Files to Import:" .Show If .SelectedItems.Count = 0 Then MsgBox "Cancelled - No Directory Selected" FilePath = "" FileSpec = "" Exit Sub Else FilePath = .SelectedItems(1) FileSpec = "*.dat" End If End With ' Create a FileSearch object: Set FS = Application.FileSearch With FS .LookIn = FilePath .Filename = FileSpec .Execute ' Exit if no files are found If .FoundFiles.Count = 0 Then MsgBox "No files were found at:'" & vbCrLf & FilePath & "'" Exit Sub End If End With ' Import Inventory data for each *.dat file found: Dim FName As String, UnitName As String, Sep As String Dim RowNdx As Integer Dim ColNdx As Integer Dim TempVal As Variant Dim WholeLine As String Dim Pos As Integer Dim NextPos As Integer Dim SaveColNdx As Integer Dim FileCode As String Application.Cursor = xlWait Application.ScreenUpdating = False For i = 1 To FS.FoundFiles.Count FName = FS.FoundFiles(i) ' Application.ScreenUpdating = True Application.StatusBar = "Processing Dat File: " & FName ' Application.ScreenUpdating = False Sep = Chr(9) Workbooks.Open Filename:=ThisWorkbook.Path & "\Inventory Template.xls" Sheets("Inventory Data").Select Range("A2").Select SaveColNdx = ActiveCell.Column RowNdx = ActiveCell.Row - 1 Open FName For Input Access Read As #1 Do While Not EOF(1) Line Input #1, WholeLine If RowNdx 1 Then If Right(WholeLine, 1) < Sep Then WholeLine = WholeLine & Sep End If ColNdx = SaveColNdx Pos = 1 NextPos = InStr(Pos, WholeLine, Sep) Do While NextPos = 1 TempVal = Mid(WholeLine, Pos, NextPos - Pos) Cells(RowNdx, ColNdx).Value = Replace(TempVal, Chr(34), "") Pos = NextPos + 1 ColNdx = ColNdx + 1 NextPos = InStr(Pos, WholeLine, Sep) Loop End If RowNdx = RowNdx + 1 Loop Range("A2").Select Close #1 ' Resize columns: Selection.CurrentRegion.Select Selection.Columns.EntireColumn.AutoFit Range("A2").Select Sheets("Inventory Data").Range("A1").CurrentRegion.Name = "DataRange" ' Refresh Pivot Tables (only need to refresh first pivot table - others use it as source) Sheets("By Vendor").PivotTables(1).PivotCache.Refresh ' Save data in template If Len(Dir(FilePath & "\Output", vbDirectory)) = 0 Then MkDir FilePath & "\Output" End If FileCode = Mid(FName, Len(FilePath) + 1, Len(FName) - Len(FilePath) - 4) If ThisWorkbook.Worksheets("Macro Data").Range("C:C").Find(FileCode, LookAt:=xlPart) Is Nothing Then UnitName = FileCode Else UnitName = Application.WorksheetFunction.VLookup(FileCode, _ ThisWorkbook.Worksheets("Macro Data").Range("C:D"), 2, 0) End If jane = FilePath & "\Output\" & UnitName & " - " & _ Format(Workbooks("Inventory Macro.xls").Worksheets("Macro Data").Range("a2"), "MM-YY") ' it's here ----------------------------V ActiveWorkbook.SaveAs Filename:=FilePath & "Output\" & UnitName & " - " & _ Format(Workbooks("Inventory Macro.xls").Worksheets("Macro Data").Range("a2"), "MM-YY"), _ FileFormat:=xlNormal, Password:="", WriteResPassword:="", _ ReadOnlyRecommended:=False, CreateBackup:=False ActiveWorkbook.Close Next i ErrorHandler: If Err < 0 Then MsgBox "Import Process Aborted" Application.ScreenUpdating = True Application.Cursor = xlDefault Application.StatusBar = False On Error GoTo 0 End Sub |
Run-time error '1004': The PivotTable field name is not valid....
I cannot find anything in this code that refers to a pivot field. It does
update the pivot cache. Updating the pivot cache may cause the pivot tables to recalc. I am guessing the problem lies in one of the pivot tables rather than in this code. Tom "SHAWTY721" wrote: Option Explicit Sub ImportInventoryData() Dim FS As FileSearch Dim FilePath, jane As String, FileSpec As String Dim i As Integer ' Select directory: With Application.FileDialog(msoFileDialogFolderPicker) .InitialFileName = ThisWorkbook.Path & "\" .Title = "Select the Directory for Inventory Files to Import:" .Show If .SelectedItems.Count = 0 Then MsgBox "Cancelled - No Directory Selected" FilePath = "" FileSpec = "" Exit Sub Else FilePath = .SelectedItems(1) FileSpec = "*.dat" End If End With ' Create a FileSearch object: Set FS = Application.FileSearch With FS .LookIn = FilePath .Filename = FileSpec .Execute ' Exit if no files are found If .FoundFiles.Count = 0 Then MsgBox "No files were found at:'" & vbCrLf & FilePath & "'" Exit Sub End If End With ' Import Inventory data for each *.dat file found: Dim FName As String, UnitName As String, Sep As String Dim RowNdx As Integer Dim ColNdx As Integer Dim TempVal As Variant Dim WholeLine As String Dim Pos As Integer Dim NextPos As Integer Dim SaveColNdx As Integer Dim FileCode As String Application.Cursor = xlWait Application.ScreenUpdating = False For i = 1 To FS.FoundFiles.Count FName = FS.FoundFiles(i) ' Application.ScreenUpdating = True Application.StatusBar = "Processing Dat File: " & FName ' Application.ScreenUpdating = False Sep = Chr(9) Workbooks.Open Filename:=ThisWorkbook.Path & "\Inventory Template.xls" Sheets("Inventory Data").Select Range("A2").Select SaveColNdx = ActiveCell.Column RowNdx = ActiveCell.Row - 1 Open FName For Input Access Read As #1 Do While Not EOF(1) Line Input #1, WholeLine If RowNdx 1 Then If Right(WholeLine, 1) < Sep Then WholeLine = WholeLine & Sep End If ColNdx = SaveColNdx Pos = 1 NextPos = InStr(Pos, WholeLine, Sep) Do While NextPos = 1 TempVal = Mid(WholeLine, Pos, NextPos - Pos) Cells(RowNdx, ColNdx).Value = Replace(TempVal, Chr(34), "") Pos = NextPos + 1 ColNdx = ColNdx + 1 NextPos = InStr(Pos, WholeLine, Sep) Loop End If RowNdx = RowNdx + 1 Loop Range("A2").Select Close #1 ' Resize columns: Selection.CurrentRegion.Select Selection.Columns.EntireColumn.AutoFit Range("A2").Select Sheets("Inventory Data").Range("A1").CurrentRegion.Name = "DataRange" ' Refresh Pivot Tables (only need to refresh first pivot table - others use it as source) Sheets("By Vendor").PivotTables(1).PivotCache.Refresh ' Save data in template If Len(Dir(FilePath & "\Output", vbDirectory)) = 0 Then MkDir FilePath & "\Output" End If FileCode = Mid(FName, Len(FilePath) + 1, Len(FName) - Len(FilePath) - 4) If ThisWorkbook.Worksheets("Macro Data").Range("C:C").Find(FileCode, LookAt:=xlPart) Is Nothing Then UnitName = FileCode Else UnitName = Application.WorksheetFunction.VLookup(FileCode, _ ThisWorkbook.Worksheets("Macro Data").Range("C:D"), 2, 0) End If jane = FilePath & "\Output\" & UnitName & " - " & _ Format(Workbooks("Inventory Macro.xls").Worksheets("Macro Data").Range("a2"), "MM-YY") ' it's here ----------------------------V ActiveWorkbook.SaveAs Filename:=FilePath & "Output\" & UnitName & " - " & _ Format(Workbooks("Inventory Macro.xls").Worksheets("Macro Data").Range("a2"), "MM-YY"), _ FileFormat:=xlNormal, Password:="", WriteResPassword:="", _ ReadOnlyRecommended:=False, CreateBackup:=False ActiveWorkbook.Close Next i ErrorHandler: If Err < 0 Then MsgBox "Import Process Aborted" Application.ScreenUpdating = True Application.Cursor = xlDefault Application.StatusBar = False On Error GoTo 0 End Sub |
All times are GMT +1. The time now is 12:58 AM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com