Inventory DDE to Excel 1

[monagan]

I am very amateur at the concept of DDE. I understand what it does, but not how to make it work. I am simply trying to update an inventory price list from peach tree to a price list in excel using the Item ID.

If you have the time or patience to help me, I'd be grateful.

Thanks.

 

[monagan]

If it's possible to do a macro I'd rather do that. I just need to get around the import export but still save my indiviual products cell location

 

[AlohaMichael]

The macro assumes the following:
1. Worksheet name is "InventoryPriceSheet" (without the quotes)
2. You list the Item ID's on row 5 in Column A
3. You create the button to run the macro on the "InventoryPriceSheet" worksheet
4. You know what a macro is
5. You know what Peachtree is
6. You own a copy of Peachtree & Excel

For the Macro to work you must do the following
1. Start Peachtree
2. Select the company you want to work with
3. The company directory is in the same root directory of Peachtree
4. Know the directory name of the company
5. Put the directory name in CELL B2
6. List the correct ITEM ID's in column A

Obviously you could change the Macro to suit your needs.

Option Explicit
[green]
'Copyright Michael Mooney --mmooney512@yahoo.com--EIPSoftware
'Getting Peachtree data through DDE
'Microsoft wrote a bunch of stuff on DDE & Windows, all of their approprate copyrights
'hold true. The rest I figured out.

'Purpose: Open the dde channel, find the info, spit it back into xls and move on.
[/green]
Sub GetInvInfo()
Dim ddeChannel As String, ItemID As String, cmpName As String
Dim ctr1 As Integer, InvRows As Long
On Error GoTo std_err                                           'standard error handler
                                                    
InvRows = NumberofRows("InventoryPriceSheet", "A", "5", 3)      'Find how many rows of Inventory Items are there
cmpName = Cells(1, 2).Value                                     'what's the name of the company in CELL B2
ddeChannel = Application.DDEInitiate("PeachW", cmpName)         'the name of the DDE channel

'Get New Values assumes first item is in row 5
For ctr1 = 5 To InvRows                                         'loop thru the Inventory Items
    ItemID = Cells(ctr1, 1).Value                               'Grab first Item ID
    Cells(ctr1, 2).Value = _
        Application.DDERequest(ddeChannel, "FILE=LINEITEM,KEY=" & ItemID & ",FIELD=NAME")       'Name of Item put in Col B
    Cells(ctr1, 3).Value = _
        Application.DDERequest(ddeChannel, "FILE=LINEITEM,KEY=" & ItemID & ",FIELD=ITEMCOST")   'Cost put in Col C
    Cells(ctr1, 4).Value = _
        Application.DDERequest(ddeChannel, "FILE=LINEITEM,KEY=" & ItemID & ",FIELD=QTYONHAND")  'Qty on Hand put in Col D
    Cells(ctr1, 5).Value = _
        Application.DDERequest(ddeChannel, "FILE=LINEITEM,KEY=" & ItemID & ",FIELD=PRICE")      'Price level 1 put in Col E
    Cells(ctr1, 6).Value = _
        Application.DDERequest(ddeChannel, "FILE=LINEITEM,KEY=" & ItemID & ",FIELD=SALESPRICE2") 'Price level 2 put in Col F
Next ctr1

Application.DDETerminate (ddeChannel)                               'close the DDE Channel

Exit Sub
std_err:
Select Case Err.Number
    Case 13                                                             'Case 13 will come up if PT can't find the data files.
        MsgBox "Could not find company", vbInformation, "No Company"
    Case Default
        MsgBox Err.Number & Chr$(13) & _
        Err.Description, vbCritical, "Error in Program"
End Select

End Sub

[green]
'Copyright Michael Mooney --mmooney512@yahoo.com--EIPSoftware

'Purpose of the function is find the number of rows on a worksheet
'When searching for the last row you have the option of determing the last row
'for a particular column and starting at a particular row. How many additional
'rows to search to see if there is any additional information.
[/green]
Function NumberofRows(WorkSheetName As String, Optional ByVal ColumnLetter As String, _
                    Optional ByVal StartingRow As Long, Optional ByVal ConsectiveEmptyRows As Long)
On Error GoTo std_err                                       'standard error handler
If ColumnLetter = "" Then ColumnLetter = "A"                'if the optional values are empty
If StartingRow = 0 Then StartingRow = 1                     'fill in default values
If ConsectiveEmptyRows = 0 Then ConsectiveEmptyRows = 1
Dim ctr1 As Long                                            'counter For..Next Loop
Dim flgEmptyRow As Boolean                                  'Flag indicates if the Row is empty
Dim priorWrkSht As String                                   'String to hold the name of the worksheet

priorWrkSht = ActiveSheet.Name                              'copy the active sheets name
    Worksheets(WorkSheetName).Activate                      'move to the worksheet you want to search
    Range(ColumnLetter & StartingRow).Select                'move to default/specified cell
    Selection.End(xlDown).Select                            'xls function to move to last row
    If ConsectiveEmptyRows > 1 Then                         'if you want to find more then 1 empty cell
                                                            'to determine the last row
        Do While ActiveCell.Row < 65535                     'Make sure we haven't exceeded xls max row
            For ctr1 = 1 To ConsectiveEmptyRows             'Loop till we find x amount of empty cells or
                StartingRow = ActiveCell.Row + ctr1         'find a non empty cell
                If Range(ColumnLetter & StartingRow).Value = Empty Then
                    flgEmptyRow = True                      'flag to hold if the cell is empty
                Else
                    flgEmptyRow = False                     'flag indicates the cell is not empty
                    Selection.End(xlDown).Select            'xls function to move to last row
                    Exit For
                End If
            Next ctr1
            If flgEmptyRow = True Then Exit Do              'uses the flag to determine whether to exit the loop
        Loop
    End If

Normal_Exit:
    If ActiveCell.Row = 65536 Then                          'Since their may be nothing on the xls worksheet
        NumberofRows = 1                                    'xls will move to the highest possible row
    Else                                                    'give 1 as default value
        NumberofRows = ActiveCell.Row
    End If
    Worksheets(priorWrkSht).Activate                        'move back to the prior worksheet
    Exit Function
    
std_err:                                                    'if an error is generated I move back to the prior
    Worksheets(priorWrkSht).Activate                        'worksheet and just return a value of 1
    NumberofRows = 1
    Exit Function
End Function